Class quark_dwf_class
In: QuarkDwOvlpClass/quark_dwf_class.F90
QuarkDwOvlpClass_v0.1/quark_dwf_class.F90
comlib lattice_class action_base_class timer_class error_class solver_parameter_class chrolog_class hmc_status_class field_fermion_class field_gauge_class quark_wilson_class field_5dfermion_class perfmon_class f95_lapack quark_ovlp_kern_eigmodes_class signfunc_mod counter_class solver_class quark_dwf_class dot/f_34.png

Defines Domainwall fermion

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]

\]

Version

$Id: quark_dwf_class.F90,v 1.24 2011/06/14 11:10:33 ishikawa Exp $

Methods

CRON_NSITE   CRON_NSITE   CRON_NSITE   CRON_NSITE   DW_TYPE_BORICI   DW_TYPE_BORICI   DW_TYPE_SHAMIR   DW_TYPE_SHAMIR   DW_TYPE_ZOLOTAREV_CHIU   DW_TYPE_ZOLOTAREV_CHIU   DW_TYPE_ZOLOTAREV_SHAMIR   DW_TYPE_ZOLOTAREV_SHAMIR   abs2   abs2   abs2   abs2   abs2   abs2   abs2   abs2   abs2   abs2   abs2   abs2   abs2   abs2   abs2   abs2   abs2   abs2   abs2   abs2   abs2   abs2   abs2   abs2   abs2   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_add   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult   accum_mult_gamma5   accum_mult_gamma5   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   accum_sub   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_add   assign_inv_mult_dwf   assign_inv_mult_dwf   assign_inv_mult_dwf   assign_inv_mult_dwf   assign_mult_dwf   assign_mult_dwf   assign_mult_dwf   assign_mult_dwf   assign_mult_gamma5   assign_mult_gamma5   assign_mult_impterm_dwf   assign_mult_impterm_dwf   assign_proj_4dto5d   assign_proj_4dto5d   assign_proj_5dto4d   assign_proj_5dto4d   assign_sub   assign_sub   assign_sub   assign_sub   assign_sub   assign_sub   assign_sub   assign_sub   assign_sub   assign_sub   assign_sub   assign_sub   assign_sub   assign_sub   assign_sub   assign_sub   assign_sub   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   clear   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_boundary   copy_fq_time   copy_fq_time   copy_fq_time   copy_fq_time   copy_fq_time   copy_fq_time   copy_fq_time   delete   delete   delete   delete   dwf_low_modes   dwf_low_modes   field_dw_quark_wg   field_dw_quark_wg   field_dw_quark_wg   field_dw_quark_wg   field_dw_quark_wg   field_dw_quark_wg   field_dw_quark_wg   field_dw_quark_wg   field_quark_eo_wg   field_quark_eo_wg   field_quark_eo_wg   field_quark_eo_wg   field_quark_eo_wg   field_quark_eo_wg   field_quark_eo_wg   field_quark_eo_wog   field_quark_eo_wog   field_quark_eo_wog   field_quark_eo_wog   field_quark_eo_wog   field_quark_eo_wog   field_quark_eo_wog   field_quark_wg   field_quark_wg   field_quark_wg   field_quark_wg   field_quark_wg   field_quark_wg   field_quark_wg   field_quark_wog   field_quark_wog   field_quark_wog   field_quark_wog   field_quark_wog   field_quark_wog   field_quark_wog   force_hmc_hopping   force_hmc_hopping   force_hmc_hopping   force_hmc_hopping   force_hmc_hopping   force_hmc_hopping   force_hmc_hopping   force_hmc_hopping   force_hmc_hopping   force_hmc_hopping   force_hmc_hopping   force_hmc_hopping   force_hmc_hopping   force_hmc_hopping   get_NS   get_NS   get_id   get_id   get_id   get_id   get_id   get_low_modes   get_low_modes   get_mass   get_mass   make_mass_term   make_mass_term   mult_hopping_tzyx_eo   mult_hopping_tzyx_eo   mult_hopping_tzyx_eo   mult_hopping_tzyx_eo   mult_hopping_tzyx_eo   mult_hopping_tzyx_eo   mult_hopping_tzyx_eo   mult_iter   mult_iter   mult_iter   mult_iter   mult_iter   mult_iter   mult_iter   new   new   new   new   pack   pack   pack   pack   pack   pack   pack   pack   pack   pack   pack   pack   pack   pack   pack   pack   pack   pack   pack   pack   pack   pack   print   print   prod   prod   prod   prod   prod   prod   prod   prod   prod   prod   prod   prod   prod   prod   prod   prod   prod   quark_domainwall   quark_domainwall   read   read   save_config   save_config   set_coef   set_coef   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_gaussian_noise   set_id   set_id   set_id   set_id   set_id   set_mass   set_mass   su3fv_spinor   su3fv_spinor   su3fv_spinor   su3fv_spinor   su3fv_spinor   su3fv_spinor   su3fv_spinor   unpack   unpack   unpack   unpack   unpack   unpack   unpack   unpack   unpack   unpack   unpack   unpack   unpack   unpack   unpack   unpack   unpack   unpack   unpack   unpack   unpack   unpack  

Included Modules

comlib lattice_class action_base_class timer_class error_class solver_parameter_class chrolog_class hmc_status_class field_fermion_class field_gauge_class quark_wilson_class field_5dfermion_class perfmon_class f95_lapack quark_ovlp_kern_eigmodes_class signfunc_mod counter_class solver_class

Public Instance methods

CRON_NSITE
Constant :
CRON_NSITE =NHSITE :integer, parameter
CRON_NSITE =NSITE :integer, parameter
CRON_NSITE
Constant :
CRON_NSITE =NHSITE :integer, parameter
CRON_NSITE =NSITE :integer, parameter
CRON_NSITE
Constant :
CRON_NSITE =NHSITE :integer, parameter
CRON_NSITE =NSITE :integer, parameter
CRON_NSITE
Constant :
CRON_NSITE =NHSITE :integer, parameter
CRON_NSITE =NSITE :integer, parameter
DW_TYPE_BORICI
Constant :
DW_TYPE_BORICI = 2 :integer, parameter
: Borici domain-wall fermion (Overlap kernel)
DW_TYPE_BORICI
Constant :
DW_TYPE_BORICI = 2 :integer, parameter
: Borici domain-wall fermion (Overlap kernel)
DW_TYPE_SHAMIR
Constant :
DW_TYPE_SHAMIR = 1 :integer, parameter
: standard domain-wall fermion (Shamir kernel)
DW_TYPE_SHAMIR
Constant :
DW_TYPE_SHAMIR = 1 :integer, parameter
: standard domain-wall fermion (Shamir kernel)
DW_TYPE_ZOLOTAREV_CHIU
Constant :
DW_TYPE_ZOLOTAREV_CHIU = 4 :integer, parameter
: Zolotarev improved fermion (Overlap, Chiu)
DW_TYPE_ZOLOTAREV_CHIU
Constant :
DW_TYPE_ZOLOTAREV_CHIU = 4 :integer, parameter
: Zolotarev improved fermion (Overlap, Chiu)
DW_TYPE_ZOLOTAREV_SHAMIR
Constant :
DW_TYPE_ZOLOTAREV_SHAMIR = 3 :integer, parameter
: Zolotarev improved fermion (Overlap with Shamir kernel)
DW_TYPE_ZOLOTAREV_SHAMIR
Constant :
DW_TYPE_ZOLOTAREV_SHAMIR = 3 :integer, parameter
: Zolotarev improved fermion (Overlap with Shamir kernel)
abs2( pe ) result(my_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

abs2( pe ) result(my_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

abs2( pe ) result(my_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

abs2( q ) result(my_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

abs2( q ) result(my_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

abs2( q ) result(my_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

abs2( q ) result(my_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

abs2( q ) result(my_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

abs2( q ) result(my_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

abs2( q ) result(my_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

abs2( q ) result(my_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

abs2( q ) result(my_abs2)
Function :
my_abs2 :real(DP)
q :type(field_quark_wg), intent(in)

return |q|^2

Original external subprogram is field_fermion_class#abs2

abs2( q ) result(my_abs2)
Function :
my_abs2 :real(DP)
q :type(field_quark_wg), intent(in)

return |q|^2

Original external subprogram is field_fermion_class#abs2

abs2( q ) result(my_abs2)
Function :
my_abs2 :real(DP)
q :type(field_quark_wg), intent(in)

return |q|^2

Original external subprogram is field_fermion_class#abs2

abs2( q, ieo ) result(fabs2)
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

abs2( q, ieo ) result(fabs2)
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

abs2( q, ieo ) result(fabs2)
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

abs2( q, ieo ) result(fabs2)
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

abs2( q, ieo ) result(fabs2)
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

abs2( q, ieo ) result(fabs2)
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

abs2( q, ieo ) result(fabs2)
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

abs2( q, ieo ) result(fabs2)
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

abs2( qe ) result(my_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

abs2( qe ) result(my_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

abs2( qe ) result(my_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

accum_add( q1, q2 )
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

accum_add( q1, q2 )
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

accum_add( q1, q2 )
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

accum_add( q1, q2 )
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

accum_add( q1, q2 )
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

accum_add( q1, q2 )
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

accum_add( q1, q2 )
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

accum_add( q1, q2 )
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

accum_add( q1, q2, ieo )
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

accum_add( q1, q2, ieo )
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

accum_add( q1, q2, ieo )
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

accum_add( q1, q2, ieo )
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

accum_add( q1, q2, ieo )
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

accum_add( q1, q2, ieo )
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

accum_add( q1, q2, ieo )
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

accum_add( q1, q2, ieo )
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

accum_add( q2, q1 )
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

accum_add( q2, q1 )
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

accum_add( q2, q1 )
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

accum_add( q2e, q1e )
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

accum_add( q2e, q1e )
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

accum_add( q2e, q1e )
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

accum_add( u2e, u1e )
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

accum_add( u2e, u1e )
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

accum_add( u2e, u1e )
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

accum_mult( q, ccoef )
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

accum_mult( q, ccoef )
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

accum_mult( q, ccoef )
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

accum_mult( q, ccoef )
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

accum_mult( q, ccoef )
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

accum_mult( q, ccoef )
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

accum_mult( q, ccoef )
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

accum_mult( q, ccoef )
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

accum_mult( q, rcoef )
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

accum_mult( q, rcoef )
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

accum_mult( q, rcoef )
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

accum_mult( q, rcoef )
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

accum_mult( q, rcoef )
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

accum_mult( q, rcoef )
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

accum_mult( q, rcoef )
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

accum_mult( q, rcoef )
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

accum_mult( q1, coef )
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

accum_mult( q1, coef )
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

accum_mult( q1, coef )
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

accum_mult( q1, coef )
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

accum_mult( q1, coef )
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

accum_mult( q1, coef )
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

accum_mult( q1, rtmp, ieo )
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

accum_mult( q1, rtmp, ieo )
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

accum_mult( q1, rtmp, ieo )
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

accum_mult( q1, rtmp, ieo )
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

accum_mult( q1, rtmp, ieo )
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

accum_mult( q1, rtmp, ieo )
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

accum_mult( q1, rtmp, ieo )
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

accum_mult( q1, rtmp, ieo )
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

accum_mult( q1e, coef )
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

accum_mult( q1e, coef )
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

accum_mult( q1e, coef )
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

accum_mult( q1e, coef )
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

accum_mult( q1e, coef )
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

accum_mult( q1e, coef )
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. $

[Source]

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. $

[Source]

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
accum_sub( q1, q2 )
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

accum_sub( q1, q2 )
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

accum_sub( q1, q2 )
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

accum_sub( q1, q2 )
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

accum_sub( q1, q2 )
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

accum_sub( q1, q2 )
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

accum_sub( q1, q2 )
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

accum_sub( q1, q2 )
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

accum_sub( q1, q2, ieo )
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

accum_sub( q1, q2, ieo )
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

accum_sub( q1, q2, ieo )
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

accum_sub( q1, q2, ieo )
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

accum_sub( q1, q2, ieo )
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

accum_sub( q1, q2, ieo )
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

accum_sub( q1, q2, ieo )
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

accum_sub( q1, q2, ieo )
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

accum_sub( q2, q1 )
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

accum_sub( q2, q1 )
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

accum_sub( q2, q1 )
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

accum_sub( q2e, q1e )
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

accum_sub( q2e, q1e )
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

accum_sub( q2e, q1e )
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

accum_sub( u2e, u1e )
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

accum_sub( u2e, u1e )
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

accum_sub( u2e, u1e )
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

assign( q, p )
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

assign( q, p )
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

assign( q, p )
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

assign( q, p )
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

assign( q, p )
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

assign( q, p )
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

assign( q, p )
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

assign( q, p )
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

assign( q1, q2, ieo )
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

assign( q1, q2, ieo )
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

assign( q1, q2, ieo )
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

assign( q1, q2, ieo )
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

assign( q1, q2, ieo )
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

assign( q1, q2, ieo )
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

assign( q1, q2, ieo )
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

assign( q1, q2, ieo )
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

assign( q2, q1 )
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

assign( q2, q1 )
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

assign( q2, q1 )
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

assign( q2e, q1e )
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

assign( q2e, q1e )
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

assign( q2e, q1e )
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

assign( qp1, qp2 )
Subroutine :
qp1 :type(quark_wilson), intent(inout)
qp2 :type(quark_wilson), intent(in)

Original external subprogram is quark_wilson_class#assign

assign( qp1, qp2 )
Subroutine :
qp1 :type(quark_wilson), intent(inout)
qp2 :type(quark_wilson), intent(in)

Original external subprogram is quark_wilson_class#assign

assign( qp1, qp2 )
Subroutine :
qp1 :type(quark_wilson), intent(inout)
qp2 :type(quark_wilson), intent(in)

Original external subprogram is quark_wilson_class#assign

assign( u2e, u1e )
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

assign( u2e, u1e )
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

assign( u2e, u1e )
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

assign_add( q3, q1, q2 )
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

assign_add( q3, q1, q2 )
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

assign_add( q3, q1, q2 )
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

assign_add( q3, q1, q2 )
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

assign_add( q3, q1, q2 )
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

assign_add( q3, q1, q2 )
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

assign_add( q3, q1, q2 )
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

assign_add( q3e, q1e, q2e )
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

assign_add( q3e, q1e, q2e )
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

assign_add( q3e, q1e, q2e )
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

assign_add( q3e, q1e, q2e )
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

assign_add( q3e, q1e, q2e )
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

assign_add( q3e, q1e, q2e )
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

assign_add( q3e, q1e, q2e )
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

assign_add( u3e, u1e, u2e )
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

assign_add( u3e, u1e, u2e )
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

assign_add( u3e, u1e, u2e )
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

assign_add( u3e, u1e, u2e )
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

assign_add( u3e, u1e, u2e )
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

assign_add( u3e, u1e, u2e )
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

assign_add( u3e, u1e, u2e )
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

[Source]

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

[Source]

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

[Source]

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

[Source]

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.

[Source]

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.

[Source]

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)
: if present, Ddw^dagger is multiplyed.

assign and multiply dwf operaotr

dq <= Ddw q

or

dq <= Ddw^dag q

[Source]

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)
: if present, Ddw^dagger is multiplyed.

assign and multiply dwf operaotr

dq <= Ddw q

or

dq <= Ddw^dag q

[Source]

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. $

[Source]

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. $

[Source]

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

[Source]

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

[Source]

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)

  • $ 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 $ .

[Source]

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)

  • $ 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 $ .

[Source]

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)

  • $ y = (P^{-} py(1) + P^{+} py(NS))/2 $

  • $ (1-\gamma_5) y = P^{-} y $ .
  • $ (1+gamma_5) y = P^{+} y $ .

[Source]

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)

  • $ y = (P^{-} py(1) + P^{+} py(NS))/2 $

  • $ (1-\gamma_5) y = P^{-} y $ .
  • $ (1+gamma_5) y = P^{+} y $ .

[Source]

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
assign_sub( q1, q2, q3, ieo )
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

assign_sub( q1, q2, q3, ieo )
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

assign_sub( q1, q2, q3, ieo )
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

assign_sub( q1, q2, q3, ieo )
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

assign_sub( q1, q2, q3, ieo )
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

assign_sub( q1, q2, q3, ieo )
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

assign_sub( q1, q2, q3, ieo )
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

assign_sub( q1, q2, q3, ieo )
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

assign_sub( q3, q1, q2 )
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

assign_sub( q3, q1, q2 )
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

assign_sub( q3, q1, q2 )
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

assign_sub( q3e, q1e, q2e )
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

assign_sub( q3e, q1e, q2e )
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

assign_sub( q3e, q1e, q2e )
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

assign_sub( u3e, u1e, u2e )
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

assign_sub( u3e, u1e, u2e )
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

assign_sub( u3e, u1e, u2e )
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

clear( q )
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

q <= 0

Original external subprogram is field_5dfermion_class#clear

clear( q )
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

q <= 0

Original external subprogram is field_5dfermion_class#clear

clear( q )
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

q <= 0

Original external subprogram is field_5dfermion_class#clear

clear( q )
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

q <= 0

Original external subprogram is field_5dfermion_class#clear

clear( q )
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

q <= 0

Original external subprogram is field_5dfermion_class#clear

clear( q )
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

q <= 0

Original external subprogram is field_5dfermion_class#clear

clear( q )
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

q <= 0

Original external subprogram is field_5dfermion_class#clear

clear( q )
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

q <= 0

Original external subprogram is field_5dfermion_class#clear

clear( q )
Subroutine :
q :type(field_quark_wg), intent(inout)

set zero on field

Original external subprogram is field_fermion_class#clear

clear( q )
Subroutine :
q :type(field_quark_wg), intent(inout)

set zero on field

Original external subprogram is field_fermion_class#clear

clear( q )
Subroutine :
q :type(field_quark_wg), intent(inout)

set zero on field

Original external subprogram is field_fermion_class#clear

clear( q )
Subroutine :
q :type(field_quark_wog), intent(inout)

set zero on field

Original external subprogram is field_fermion_class#clear

clear( q )
Subroutine :
q :type(field_quark_wog), intent(inout)

set zero on field

Original external subprogram is field_fermion_class#clear

clear( q )
Subroutine :
q :type(field_quark_wog), intent(inout)

set zero on field

Original external subprogram is field_fermion_class#clear

clear( qe )
Subroutine :
qe :type(field_quark_eo_wg), intent(inout)

set zero on field

Original external subprogram is field_fermion_class#clear

clear( qe )
Subroutine :
qe :type(field_quark_eo_wg), intent(inout)

set zero on field

Original external subprogram is field_fermion_class#clear

clear( qe )
Subroutine :
qe :type(field_quark_eo_wg), intent(inout)

set zero on field

Original external subprogram is field_fermion_class#clear

clear( qe )
Subroutine :
qe :type(field_quark_eo_wog), intent(inout)

set zero on field

Original external subprogram is field_fermion_class#clear

clear( qe )
Subroutine :
qe :type(field_quark_eo_wog), intent(inout)

set zero on field

Original external subprogram is field_fermion_class#clear

clear( qe )
Subroutine :
qe :type(field_quark_eo_wog), intent(inout)

set zero on field

Original external subprogram is field_fermion_class#clear

clear( u )
Subroutine :
u :type(tfield_gluon_wg), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( u )
Subroutine :
u :type(tfield_gluon_wg), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( u )
Subroutine :
u :type(tfield_gluon_wg), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( u )
Subroutine :
u :type(vfield_gluon_wg), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( u )
Subroutine :
u :type(vfield_gluon_wg), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( u )
Subroutine :
u :type(vfield_gluon_wg), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( u )
Subroutine :
u :type(vfield_gluon_wog), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( u )
Subroutine :
u :type(vfield_gluon_wog), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( u )
Subroutine :
u :type(vfield_gluon_wog), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( ue )
Subroutine :
ue :type(sfield_gluon_eo_wg), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( ue )
Subroutine :
ue :type(sfield_gluon_eo_wg), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( ue )
Subroutine :
ue :type(sfield_gluon_eo_wg), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( ue )
Subroutine :
ue :type(sfield_gluon_eo_wog), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( ue )
Subroutine :
ue :type(sfield_gluon_eo_wog), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( ue )
Subroutine :
ue :type(sfield_gluon_eo_wog), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( ue )
Subroutine :
ue :type(tfield_gluon_eo_wg), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( ue )
Subroutine :
ue :type(tfield_gluon_eo_wg), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( ue )
Subroutine :
ue :type(tfield_gluon_eo_wg), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( ue )
Subroutine :
ue :type(vfield_gluon_eo_wg), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( ue )
Subroutine :
ue :type(vfield_gluon_eo_wg), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( ue )
Subroutine :
ue :type(vfield_gluon_eo_wg), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( ue )
Subroutine :
ue :type(vfield_gluon_eo_wog), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( ue )
Subroutine :
ue :type(vfield_gluon_eo_wog), intent(inout)

Original external subprogram is field_gauge_class#clear

clear( ue )
Subroutine :
ue :type(vfield_gluon_eo_wog), intent(inout)

Original external subprogram is field_gauge_class#clear

copy_boundary( q )
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

copy boundary

Original external subprogram is field_5dfermion_class#copy_boundary

copy_boundary( q )
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

copy boundary

Original external subprogram is field_5dfermion_class#copy_boundary

copy_boundary( q )
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

copy boundary

Original external subprogram is field_5dfermion_class#copy_boundary

copy_boundary( q )
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

copy boundary

Original external subprogram is field_5dfermion_class#copy_boundary

copy_boundary( q )
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

copy boundary

Original external subprogram is field_5dfermion_class#copy_boundary

copy_boundary( q )
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

copy boundary

Original external subprogram is field_5dfermion_class#copy_boundary

copy_boundary( q )
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

copy boundary

Original external subprogram is field_5dfermion_class#copy_boundary

copy_boundary( q )
Subroutine :
q :type(field_dw_quark_wg), intent(inout)

copy boundary

Original external subprogram is field_5dfermion_class#copy_boundary

copy_boundary( u )
Subroutine :
u :type(sfield_gluon_wg), intent(inout)

Original external subprogram is field_gauge_class#copy_boundary

copy_boundary( u )
Subroutine :
u :type(sfield_gluon_wg), intent(inout)

Original external subprogram is field_gauge_class#copy_boundary

copy_boundary( u )
Subroutine :
u :type(sfield_gluon_wg), intent(inout)

Original external subprogram is field_gauge_class#copy_boundary

copy_boundary( u )
Subroutine :
u :type(tfield_gluon_wg), intent(inout)

Original external subprogram is field_gauge_class#copy_boundary

copy_boundary( u )
Subroutine :
u :type(tfield_gluon_wg), intent(inout)

Original external subprogram is field_gauge_class#copy_boundary

copy_boundary( u )
Subroutine :
u :type(tfield_gluon_wg), intent(inout)

Original external subprogram is field_gauge_class#copy_boundary

copy_boundary( u )
Subroutine :
u :type(vfield_gluon_wg), intent(inout)

Original external subprogram is field_gauge_class#copy_boundary

copy_boundary( u )
Subroutine :
u :type(vfield_gluon_wg), intent(inout)

Original external subprogram is field_gauge_class#copy_boundary

copy_boundary( u )
Subroutine :
u :type(vfield_gluon_wg), intent(inout)

Original external subprogram is field_gauge_class#copy_boundary

copy_boundary( ue )
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

copy_boundary( ue )
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

copy_boundary( ue )
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

copy_boundary( ue )
Subroutine :
ue :type(tfield_gluon_eo_wg), intent(inout)

Original external subprogram is field_gauge_class#copy_boundary

copy_boundary( ue )
Subroutine :
ue :type(tfield_gluon_eo_wg), intent(inout)

Original external subprogram is field_gauge_class#copy_boundary

copy_boundary( ue )
Subroutine :
ue :type(tfield_gluon_eo_wg), intent(inout)

Original external subprogram is field_gauge_class#copy_boundary

copy_boundary( ue )
Subroutine :
ue :type(vfield_gluon_eo_wg), intent(inout)

Original external subprogram is field_gauge_class#copy_boundary

copy_boundary( ue )
Subroutine :
ue :type(vfield_gluon_eo_wg), intent(inout)

Original external subprogram is field_gauge_class#copy_boundary

copy_boundary( ue )
Subroutine :
ue :type(vfield_gluon_eo_wg), intent(inout)

Original external subprogram is field_gauge_class#copy_boundary

copy_boundary( y )
Subroutine :
y :type(field_quark_wg), intent(inout)
 Boundary copy

Original external subprogram is field_fermion_class#copy_boundary

copy_boundary( y )
Subroutine :
y :type(field_quark_wg), intent(inout)
 Boundary copy

Original external subprogram is field_fermion_class#copy_boundary

copy_boundary( y )
Subroutine :
y :type(field_quark_wg), intent(inout)
 Boundary copy

Original external subprogram is field_fermion_class#copy_boundary

copy_boundary( ye )
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

copy_boundary( ye )
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

copy_boundary( ye )
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

copy_fq_time
Variable :
copy_fq_time :type(timer), save
: contains total boundary copy elapse time

Original external subprogram is field_5dfermion_class#copy_fq_time

copy_fq_time
Variable :
copy_fq_time :type(timer), save
: contains total boundary copy elapse time

Original external subprogram is field_5dfermion_class#copy_fq_time

copy_fq_time
Variable :
copy_fq_time :type(timer), save
: contains total boundary copy elapse time

Original external subprogram is field_5dfermion_class#copy_fq_time

copy_fq_time
Variable :
copy_fq_time :type(timer), save
: contains total boundary copy elapse time

Original external subprogram is field_5dfermion_class#copy_fq_time

copy_fq_time
Variable :
copy_fq_time :type(timer), save
: contains total boundary copy elapse time

Original external subprogram is field_fermion_class#copy_fq_time

copy_fq_time
Variable :
copy_fq_time :type(timer), save
: contains total boundary copy elapse time

Original external subprogram is field_fermion_class#copy_fq_time

copy_fq_time
Variable :
copy_fq_time :type(timer), save
: contains total boundary copy elapse time

Original external subprogram is field_fermion_class#copy_fq_time

Subroutine :
this :class(quark_domainwall), intent(inout)

delete dwf parameter

[Source]

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

[Source]

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

[Source]

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

[Source]

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
dwf_low_modes
Derived Type :
NEV :integer

low modes continer for domain wall operator

dwf_low_modes
Derived Type :
NEV :integer

low modes continer for domain wall operator

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

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

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

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

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

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

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

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

field_quark_eo_wg
Derived Type :
s(0:NTH,0:NZ1,0:NY1,0:NX1) :type(su3fv_spinor)
: field
ieo :integer
: even-ness/odd-ness index
idummy(3) :integer
: dummy for memory alignment
 quark field on even/odd sites with ghost sites

Original external subprogram is field_5dfermion_class#field_quark_eo_wg

field_quark_eo_wg
Derived Type :
s(0:NTH,0:NZ1,0:NY1,0:NX1) :type(su3fv_spinor)
: field
ieo :integer
: even-ness/odd-ness index
idummy(3) :integer
: dummy for memory alignment
 quark field on even/odd sites with ghost sites

Original external subprogram is field_5dfermion_class#field_quark_eo_wg

field_quark_eo_wg
Derived Type :
s(0:NTH,0:NZ1,0:NY1,0:NX1) :type(su3fv_spinor)
: field
ieo :integer
: even-ness/odd-ness index
idummy(3) :integer
: dummy for memory alignment
 quark field on even/odd sites with ghost sites

Original external subprogram is field_5dfermion_class#field_quark_eo_wg

field_quark_eo_wg
Derived Type :
s(0:NTH,0:NZ1,0:NY1,0:NX1) :type(su3fv_spinor)
: field
ieo :integer
: even-ness/odd-ness index
idummy(3) :integer
: dummy for memory alignment
 quark field on even/odd sites with ghost sites

Original external subprogram is field_5dfermion_class#field_quark_eo_wg

field_quark_eo_wg
Derived Type :
s(0:NTH,0:NZ1,0:NY1,0:NX1) :type(su3fv_spinor)
: field
ieo :integer
: even-ness/odd-ness index
idummy(3) :integer
: dummy for memory alignment
 quark field on even/odd sites with ghost sites

Original external subprogram is field_fermion_class#field_quark_eo_wg

field_quark_eo_wg
Derived Type :
s(0:NTH,0:NZ1,0:NY1,0:NX1) :type(su3fv_spinor)
: field
ieo :integer
: even-ness/odd-ness index
idummy(3) :integer
: dummy for memory alignment
 quark field on even/odd sites with ghost sites

Original external subprogram is field_fermion_class#field_quark_eo_wg

field_quark_eo_wg
Derived Type :
s(0:NTH,0:NZ1,0:NY1,0:NX1) :type(su3fv_spinor)
: field
ieo :integer
: even-ness/odd-ness index
idummy(3) :integer
: dummy for memory alignment
 quark field on even/odd sites with ghost sites

Original external subprogram is field_fermion_class#field_quark_eo_wg

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

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

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

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

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

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

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

field_quark_wg
Derived Type :
eo(0:1) :type(field_quark_eo_wg)
: even+odd field
 quark field with ghost sites

Original external subprogram is field_5dfermion_class#field_quark_wg

field_quark_wg
Derived Type :
eo(0:1) :type(field_quark_eo_wg)
: even+odd field
 quark field with ghost sites

Original external subprogram is field_5dfermion_class#field_quark_wg

field_quark_wg
Derived Type :
eo(0:1) :type(field_quark_eo_wg)
: even+odd field
 quark field with ghost sites

Original external subprogram is field_5dfermion_class#field_quark_wg

field_quark_wg
Derived Type :
eo(0:1) :type(field_quark_eo_wg)
: even+odd field
 quark field with ghost sites

Original external subprogram is field_5dfermion_class#field_quark_wg

field_quark_wg
Derived Type :
eo(0:1) :type(field_quark_eo_wg)
: even+odd field
 quark field with ghost sites

Original external subprogram is field_fermion_class#field_quark_wg

field_quark_wg
Derived Type :
eo(0:1) :type(field_quark_eo_wg)
: even+odd field
 quark field with ghost sites

Original external subprogram is field_fermion_class#field_quark_wg

field_quark_wg
Derived Type :
eo(0:1) :type(field_quark_eo_wg)
: even+odd field
 quark field with ghost sites

Original external subprogram is field_fermion_class#field_quark_wg

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

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

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

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

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

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

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

force_hmc_hopping( BB, fcoef, fx, fy )
Subroutine :
BB :type(vfield_gluon_wg), intent(inout)
: contribution (dot{u})
fcoef :real(DP), intent(in)
: force coefficient
fx :type(field_dw_quark_wg), intent(inout)
: DW fermion
fy :type(field_dw_quark_wg), intent(inout)
: DW fermion

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

force_hmc_hopping( BB, fcoef, fx, fy )
Subroutine :
BB :type(vfield_gluon_wg), intent(inout)
: contribution (dot{u})
fcoef :real(DP), intent(in)
: force coefficient
fx :type(field_dw_quark_wg), intent(inout)
: DW fermion
fy :type(field_dw_quark_wg), intent(inout)
: DW fermion

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

force_hmc_hopping( BB, fcoef, fx, fy )
Subroutine :
BB :type(vfield_gluon_wg), intent(inout)
: contribution (dot{u})
fcoef :real(DP), intent(in)
: force coefficient
fx :type(field_dw_quark_wg), intent(inout)
: DW fermion
fy :type(field_dw_quark_wg), intent(inout)
: DW fermion

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

force_hmc_hopping( BB, fcoef, fx, fy )
Subroutine :
BB :type(vfield_gluon_wg), intent(inout)
: contribution (dot{u})
fcoef :real(DP), intent(in)
: force coefficient
fx :type(field_dw_quark_wg), intent(inout)
: DW fermion
fy :type(field_dw_quark_wg), intent(inout)
: DW fermion

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

force_hmc_hopping( BB, fcoef, fx, fy )
Subroutine :
BB :type(vfield_gluon_wg), intent(inout)
: contribution (dot{u})
fcoef :real(DP), intent(in)
: force coefficient
fx :type(field_dw_quark_wg), intent(inout)
: DW fermion
fy :type(field_dw_quark_wg), intent(inout)
: DW fermion

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

force_hmc_hopping( BB, fcoef, fx, fy )
Subroutine :
BB :type(vfield_gluon_wg), intent(inout)
: contribution (dot{u})
fcoef :real(DP), intent(in)
: force coefficient
fx :type(field_dw_quark_wg), intent(inout)
: DW fermion
fy :type(field_dw_quark_wg), intent(inout)
: DW fermion

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

force_hmc_hopping( BB, fcoef, fx, fy )
Subroutine :
BB :type(vfield_gluon_wg), intent(inout)
: contribution (dot{u})
fcoef :real(DP), intent(in)
: force coefficient
fx :type(field_dw_quark_wg), intent(inout)
: DW fermion
fy :type(field_dw_quark_wg), intent(inout)
: DW fermion

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

force_hmc_hopping( BB, fcoef, fx, fy )
Subroutine :
BB :type(vfield_gluon_wg), intent(inout)
: contribution (dot{u})
fcoef :real(DP), intent(in)
: force coefficient
fx :type(field_dw_quark_wg), intent(inout)
: DW fermion
fy :type(field_dw_quark_wg), intent(inout)
: DW fermion

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

force_hmc_hopping( BB, fcoef, fx, fy )
Subroutine :
BB :type(vfield_gluon_wg), intent(inout)
: pre-force
fcoef :real(DP), intent(in)
: force coefficient
fx :type(field_quark_wg), intent(in)
: external fermion field
fy :type(field_quark_wg), intent(in)
: external fermion field

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

force_hmc_hopping( BB, fcoef, fx, fy )
Subroutine :
BB :type(vfield_gluon_wg), intent(inout)
: pre-force
fcoef :real(DP), intent(in)
: force coefficient
fx :type(field_quark_wg), intent(in)
: external fermion field
fy :type(field_quark_wg), intent(in)
: external fermion field

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

force_hmc_hopping( BB, fcoef, fx, fy )
Subroutine :
BB :type(vfield_gluon_wg), intent(inout)
: pre-force
fcoef :real(DP), intent(in)
: force coefficient
fx :type(field_quark_wg), intent(in)
: external fermion field
fy :type(field_quark_wg), intent(in)
: external fermion field

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

force_hmc_hopping( BBe, fcoef, fxe, fxo, fye, fyo )
Subroutine :
BBe :type(vfield_gluon_eo_wg), intent(inout)
: even/odd site force contribution (dot{u})
fcoef :real(DP), intent(in)
: force coefficient
fxe :type(field_quark_eo_wg), intent(in)
: even/odd site pseudo fermion
fxo :type(field_quark_eo_wg), intent(in)
: odd/even site pseudo fermion
fye :type(field_quark_eo_wg), intent(in)
: even/odd site pseudo fermion
fyo :type(field_quark_eo_wg), intent(in)
: odd/even site pseudo fermion

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

force_hmc_hopping( BBe, fcoef, fxe, fxo, fye, fyo )
Subroutine :
BBe :type(vfield_gluon_eo_wg), intent(inout)
: even/odd site force contribution (dot{u})
fcoef :real(DP), intent(in)
: force coefficient
fxe :type(field_quark_eo_wg), intent(in)
: even/odd site pseudo fermion
fxo :type(field_quark_eo_wg), intent(in)
: odd/even site pseudo fermion
fye :type(field_quark_eo_wg), intent(in)
: even/odd site pseudo fermion
fyo :type(field_quark_eo_wg), intent(in)
: odd/even site pseudo fermion

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

force_hmc_hopping( BBe, fcoef, fxe, fxo, fye, fyo )
Subroutine :
BBe :type(vfield_gluon_eo_wg), intent(inout)
: even/odd site force contribution (dot{u})
fcoef :real(DP), intent(in)
: force coefficient
fxe :type(field_quark_eo_wg), intent(in)
: even/odd site pseudo fermion
fxo :type(field_quark_eo_wg), intent(in)
: odd/even site pseudo fermion
fye :type(field_quark_eo_wg), intent(in)
: even/odd site pseudo fermion
fyo :type(field_quark_eo_wg), intent(in)
: odd/even site pseudo fermion

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)

[Source]

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)

[Source]

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
get_id( this ) result(id)
Function :
id :integer
this :class(action_parameters), intent(in)

Original external subprogram is quark_wilson_class#get_id

get_id( this ) result(id)
Function :
id :integer
this :class(action_parameters), intent(in)

Original external subprogram is quark_wilson_class#get_id

get_id( this ) result(id)
Function :
id :integer
this :class(action_parameters), intent(in)

Original external subprogram is action_base_class#get_id

get_id( this ) result(id)
Function :
id :integer
this :class(action_parameters), intent(in)

Original external subprogram is action_base_class#get_id

get_id( this ) result(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

[Source]

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

[Source]

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

[Source]

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

[Source]

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

[Source]

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

[Source]

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
mult_hopping_tzyx_eo( yde, yo, u )
Subroutine :
yde :type(field_quark_eo_wg), intent(inout)
: even/odd site fermion vector (output)
yo :type(field_quark_eo_wg), intent(in)
: odd/even site fermion vector (input)
u :type(vfield_gluon_wg), intent(in)
: gauge field

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

mult_hopping_tzyx_eo( yde, yo, u )
Subroutine :
yde :type(field_quark_eo_wg), intent(inout)
: even/odd site fermion vector (output)
yo :type(field_quark_eo_wg), intent(in)
: odd/even site fermion vector (input)
u :type(vfield_gluon_wg), intent(in)
: gauge field

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

mult_hopping_tzyx_eo( yde, yo, u )
Subroutine :
yde :type(field_quark_eo_wg), intent(inout)
: even/odd site fermion vector (output)
yo :type(field_quark_eo_wg), intent(in)
: odd/even site fermion vector (input)
u :type(vfield_gluon_wg), intent(in)
: gauge field

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

mult_hopping_tzyx_eo( yde, yo, u )
Subroutine :
yde :type(field_quark_eo_wg), intent(inout)
: even/odd site fermion vector (output)
yo :type(field_quark_eo_wg), intent(in)
: odd/even site fermion vector (input)
u :type(vfield_gluon_wg), intent(in)
: gauge field

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

mult_hopping_tzyx_eo( yde, yo, u )
Subroutine :
yde :type(field_quark_eo_wg), intent(inout)
: even/odd site fermion vector (output)
yo :type(field_quark_eo_wg), intent(in)
: odd/even site fermion vector (input)
u :type(vfield_gluon_wg), intent(in)
: gauge field

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

mult_hopping_tzyx_eo( yde, yo, u )
Subroutine :
yde :type(field_quark_eo_wg), intent(inout)
: even/odd site fermion vector (output)
yo :type(field_quark_eo_wg), intent(in)
: odd/even site fermion vector (input)
u :type(vfield_gluon_wg), intent(in)
: gauge field

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

mult_hopping_tzyx_eo( yde, yo, u )
Subroutine :
yde :type(field_quark_eo_wg), intent(inout)
: even/odd site fermion vector (output)
yo :type(field_quark_eo_wg), intent(in)
: odd/even site fermion vector (input)
u :type(vfield_gluon_wg), intent(in)
: gauge field

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

mult_iter
Variable :
mult_iter :type(counter), save
: contains half hopping multiplication counts

Original external subprogram is field_5dfermion_class#mult_iter

mult_iter
Variable :
mult_iter :type(counter), save
: contains half hopping multiplication counts

Original external subprogram is field_5dfermion_class#mult_iter

mult_iter
Variable :
mult_iter :type(counter), save
: contains half hopping multiplication counts

Original external subprogram is field_5dfermion_class#mult_iter

mult_iter
Variable :
mult_iter :type(counter), save
: contains half hopping multiplication counts

Original external subprogram is field_5dfermion_class#mult_iter

mult_iter
Variable :
mult_iter :type(counter), save
: contains half hopping multiplication counts

Original external subprogram is field_fermion_class#mult_iter

mult_iter
Variable :
mult_iter :type(counter), save
: contains half hopping multiplication counts

Original external subprogram is field_fermion_class#mult_iter

mult_iter
Variable :
mult_iter :type(counter), save
: contains half hopping multiplication counts

Original external subprogram is field_fermion_class#mult_iter

Subroutine :
this :type(dwf_low_modes), intent(inout)

create/initialize dwf low-modes container

[Source]

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

[Source]

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

[Source]

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

[Source]

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
pack( y, v )
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

pack( y, v )
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

pack( y, v )
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

pack( y, v )
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

pack( y, v )
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

pack( y, v )
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

pack( y, v )
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

pack( y, v )
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

pack( y, v )
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

pack( y, v )
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

pack( y, v )
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

pack( y, v, ieo )
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

pack( y, v, ieo )
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

pack( y, v, ieo )
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

pack( y, v, ieo )
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

pack( y, v, ieo )
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

pack( y, v, ieo )
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

pack( y, v, ieo )
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

pack( y, v, ieo )
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

pack( yeo, vec )
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

pack( yeo, vec )
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

pack( yeo, vec )
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

[Source]

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

[Source]

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
prod( q, p ) result(a)
Function :
a :complex(DP)
q(:) :complex(DP), intent(in)
p(:) :complex(DP), intent(in)

Original external subprogram is chrolog_class#prod

prod( q, p ) result(a)
Function :
a :complex(DP)
q(:) :complex(DP), intent(in)
p(:) :complex(DP), intent(in)

Original external subprogram is chrolog_class#prod

prod( q, p ) result(a)
Function :
a :complex(DP)
q(:) :complex(DP), intent(in)
p(:) :complex(DP), intent(in)

Original external subprogram is chrolog_class#prod

prod( q, p ) result(my_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

prod( q, p ) result(my_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

prod( q, p ) result(my_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

prod( q, p ) result(my_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

prod( q, p ) result(my_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

prod( q, p ) result(my_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

prod( q, p ) result(my_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

prod( q, p ) result(my_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

prod( q1, q2 ) result(my_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

prod( q1, q2 ) result(my_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

prod( q1, q2 ) result(my_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

prod( q1e, q2e ) result(my_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

prod( q1e, q2e ) result(my_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

prod( q1e, q2e ) result(my_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

quark_domainwall
Derived Type :

Domainwall fermion/truncated DW Overlap fermion parameters

quark_domainwall
Derived Type :

Domainwall fermion/truncated DW Overlap fermion parameters

Subroutine :
this :class(quark_domainwall), intent(inout)
iout :integer, intent(in)

read dwf paramters

[Source]

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

[Source]

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

[Source]

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

[Source]

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

[Source]

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

[Source]

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
set_gaussian_noise( p )
Subroutine :
p :type(vfield_gluon_wog), intent(inout)
: gauge momentum field

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

set_gaussian_noise( p )
Subroutine :
p :type(vfield_gluon_wog), intent(inout)
: gauge momentum field

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

set_gaussian_noise( p )
Subroutine :
p :type(vfield_gluon_wog), intent(inout)
: gauge momentum field

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

set_gaussian_noise( p )
Subroutine :
p :type(vfield_gluon_wog), intent(inout)
: gauge momentum field

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

set_gaussian_noise( p )
Subroutine :
p :type(vfield_gluon_wog), intent(inout)
: gauge momentum field

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

set_gaussian_noise( p )
Subroutine :
p :type(vfield_gluon_wog), intent(inout)
: gauge momentum field

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

set_gaussian_noise( p )
Subroutine :
p :type(vfield_gluon_wog), intent(inout)
: gauge momentum field

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

set_gaussian_noise( p )
Subroutine :
p :type(vfield_gluon_wog), intent(inout)
: gauge momentum field

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

set_gaussian_noise( p )
Subroutine :
p :type(vfield_gluon_wog), intent(inout)
: gauge momentum field

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

set_gaussian_noise( y )
Subroutine :
y :type(field_quark_wg), intent(inout)

set Gaussian noise on y

Original external subprogram is field_5dfermion_class#set_gaussian_noise

set_gaussian_noise( y )
Subroutine :
y :type(field_quark_wg), intent(inout)

set Gaussian noise on y

Original external subprogram is field_5dfermion_class#set_gaussian_noise

set_gaussian_noise( y )
Subroutine :
y :type(field_quark_wg), intent(inout)

set Gaussian noise on y

Original external subprogram is field_5dfermion_class#set_gaussian_noise

set_gaussian_noise( y )
Subroutine :
y :type(field_quark_wg), intent(inout)

set Gaussian noise on y

Original external subprogram is field_5dfermion_class#set_gaussian_noise

set_gaussian_noise( y )
Subroutine :
y :type(field_quark_wg), intent(inout)

set Gaussian noise on y

Original external subprogram is quark_wilson_class#set_gaussian_noise

set_gaussian_noise( y )
Subroutine :
y :type(field_quark_wg), intent(inout)

set Gaussian noise on y

Original external subprogram is quark_wilson_class#set_gaussian_noise

set_gaussian_noise( y )
Subroutine :
y :type(field_quark_wg), intent(inout)

set Gaussian noise on y

Original external subprogram is field_fermion_class#set_gaussian_noise

set_gaussian_noise( y )
Subroutine :
y :type(field_quark_wg), intent(inout)

set Gaussian noise on y

Original external subprogram is field_fermion_class#set_gaussian_noise

set_gaussian_noise( y )
Subroutine :
y :type(field_quark_wg), intent(inout)

set Gaussian noise on y

Original external subprogram is field_fermion_class#set_gaussian_noise

set_gaussian_noise( ye )
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

set_gaussian_noise( ye )
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

set_gaussian_noise( ye )
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

set_gaussian_noise( ye )
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

set_gaussian_noise( ye )
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

set_gaussian_noise( ye )
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

set_gaussian_noise( ye )
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

set_gaussian_noise( ye )
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

set_gaussian_noise( ye )
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

set_id( this, id )
Subroutine :
this :class(action_parameters), intent(inout)
id :integer, intent(in)

Original external subprogram is quark_wilson_class#set_id

set_id( this, id )
Subroutine :
this :class(action_parameters), intent(inout)
id :integer, intent(in)

Original external subprogram is quark_wilson_class#set_id

set_id( this, id )
Subroutine :
this :class(action_parameters), intent(inout)
id :integer, intent(in)

Original external subprogram is action_base_class#set_id

set_id( this, id )
Subroutine :
this :class(action_parameters), intent(inout)
id :integer, intent(in)

Original external subprogram is action_base_class#set_id

set_id( this, 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

[Source]

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

[Source]

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
su3fv_spinor
Derived Type :
y(COL,SPIN) :complex(DP)
 su(3) fundamentarl rep vector, spinor

Original external subprogram is field_5dfermion_class#su3fv_spinor

su3fv_spinor
Derived Type :
y(COL,SPIN) :complex(DP)
 su(3) fundamentarl rep vector, spinor

Original external subprogram is field_5dfermion_class#su3fv_spinor

su3fv_spinor
Derived Type :
y(COL,SPIN) :complex(DP)
 su(3) fundamentarl rep vector, spinor

Original external subprogram is field_5dfermion_class#su3fv_spinor

su3fv_spinor
Derived Type :
y(COL,SPIN) :complex(DP)
 su(3) fundamentarl rep vector, spinor

Original external subprogram is field_5dfermion_class#su3fv_spinor

su3fv_spinor
Derived Type :
y(COL,SPIN) :complex(DP)
 su(3) fundamentarl rep vector, spinor

Original external subprogram is field_fermion_class#su3fv_spinor

su3fv_spinor
Derived Type :
y(COL,SPIN) :complex(DP)
 su(3) fundamentarl rep vector, spinor

Original external subprogram is field_fermion_class#su3fv_spinor

su3fv_spinor
Derived Type :
y(COL,SPIN) :complex(DP)
 su(3) fundamentarl rep vector, spinor

Original external subprogram is field_fermion_class#su3fv_spinor

unpack( v, y )
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

unpack( v, y )
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

unpack( v, y )
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

unpack( v, y )
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

unpack( v, y )
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

unpack( v, y )
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

unpack( v, y )
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

unpack( v, y )
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

unpack( v, y )
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

unpack( v, y )
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

unpack( v, y )
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

unpack( v, y, ieo )
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

unpack( v, y, ieo )
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

unpack( v, y, ieo )
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

unpack( v, y, ieo )
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

unpack( v, y, ieo )
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

unpack( v, y, ieo )
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

unpack( v, y, ieo )
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

unpack( v, y, ieo )
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

unpack( vec, yeo )
Subroutine :
vec(COL*SPIN*NTH*NZ*NY*NX) :complex(DP), intent(in)
yeo :type(field_quark_eo_wg), intent(inout)
: even/odd fermion field. one shout set even/odd-ness.

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

unpack( vec, yeo )
Subroutine :
vec(COL*SPIN*NTH*NZ*NY*NX) :complex(DP), intent(in)
yeo :type(field_quark_eo_wg), intent(inout)
: even/odd fermion field. one shout set even/odd-ness.

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

unpack( vec, yeo )
Subroutine :
vec(COL*SPIN*NTH*NZ*NY*NX) :complex(DP), intent(in)
yeo :type(field_quark_eo_wg), intent(inout)
: even/odd fermion field. one shout set even/odd-ness.

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