Class main_singlet_class
In: SingletMesons_Simple_v1.3/VERYOLD/OLD2/main_singlet_class.F90
SingletMesons_Simple_v1.3/main_singlet_class.F90
config_profile_class timer_class comlib filename lattice_class solver_parameter_class inverse_class logging_class gauge_field_class gauge_field_dd_class single_prec_class wilson_quark_field_class wilson_quark_field_dd_class wilson_quark_dd_class s_cchlf_class clover_quark_class clover_quark_dd_class wilson_quark_parameter_class gauge_dd_class quark_prop_class wavefunc_class main_hadron_class error_class random_class print_status_class logfile_class field_gauge_class field_fermion_class quark_clover_class quark_wilson_class hadron_class gamma_matrix_class file_tools_class hmc_status_class main_singlet_class dot/f_110.png

This contains singlet meson measurement controll routines

Methods

Included Modules

config_profile_class timer_class comlib filename lattice_class solver_parameter_class inverse_class logging_class gauge_field_class gauge_field_dd_class single_prec_class wilson_quark_field_class wilson_quark_field_dd_class wilson_quark_dd_class s_cchlf_class clover_quark_class clover_quark_dd_class wilson_quark_parameter_class gauge_dd_class quark_prop_class wavefunc_class main_hadron_class error_class random_class print_status_class logfile_class field_gauge_class field_fermion_class quark_clover_class quark_wilson_class hadron_class gamma_matrix_class file_tools_class hmc_status_class

Public Instance methods

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

[Source]

subroutine delete_main_singlet(this)
  implicit none
  type(main_singlet_obj), intent(inout) :: this

  call tac(this%fft_time)
  call average(this%fft_time)
  if (nodeid==0) then
    write(*,'(80("="))')
    write(*,'(" FFT ETime:",E24.16)')this%fft_time%elapse
  endif
  call delete(this%hadrons)

  return
end subroutine
Subroutine :
this :type(main_singlet_obj), intent(inout)

[Source]

subroutine delete_main_singlet(this)
  implicit none
  type(main_singlet_obj), intent(inout) :: this

  call tac(this%fft_time)
  call average(this%fft_time)
  if (nodeid==0) then
    write(*,'(80("="))')
    write(*,'(" FFT ETime:",E24.16)')this%fft_time%elapse
  endif
  call delete(this%hadrons)

  return
end subroutine
m_rand
Variable :
m_rand :type(rand_gfsr_obj), save
main_hadron_obj
Derived Type :
u => NULL() :type(gvfield_dd_wg_obj), pointer
quark_parameter(:) => NULL() :type(quark_prop_parameter_obj), pointer
wavefunc(:) => NULL() :type(wavefunc_param_obj), pointer
config_prof :type(config_profile_obj)
config_name :character(len=CHARLEN)
config_path :character(len=CHARLEN)
fname :character(len=CHARLEN)
input_fname :character(len=CHARLEN)
cwd :character(len=CHARLEN)
job_id :character(len=CHARLEN)
cdate :character(len=CHARLEN)
ctime :character(len=CHARLEN)
czone :character(len=CHARLEN)
comment :character(len=CHARLEN)
str :character(len=CHARLEN)
hadron_path :character(len=CHARLEN)
num_quark :integer
num_wave :integer
ini_traj :integer
end_traj :integer
traj_skip :integer
traj :integer
solver_log :type(logging_obj), pointer
run_time :type(timer_obj)

Original external subprogram is main_hadron_class#main_hadron_obj

main_hadron_obj
Derived Type :
u => NULL() :type(gvfield_dd_wg_obj), pointer
quark_parameter(:) => NULL() :type(quark_prop_parameter_obj), pointer
wavefunc(:) => NULL() :type(wavefunc_param_obj), pointer
config_prof :type(config_profile_obj)
config_name :character(len=CHARLEN)
config_path :character(len=CHARLEN)
fname :character(len=CHARLEN)
input_fname :character(len=CHARLEN)
cwd :character(len=CHARLEN)
job_id :character(len=CHARLEN)
cdate :character(len=CHARLEN)
ctime :character(len=CHARLEN)
czone :character(len=CHARLEN)
comment :character(len=CHARLEN)
str :character(len=CHARLEN)
hadron_path :character(len=CHARLEN)
num_quark :integer
num_wave :integer
ini_traj :integer
end_traj :integer
traj_skip :integer
traj :integer
solver_log :type(logging_obj), pointer
run_time :type(timer_obj)

Original external subprogram is main_hadron_class#main_hadron_obj

main_hadron_obj
Derived Type :
u => NULL() :type(gvfield_dd_wg_obj), pointer
quark_parameter(:) => NULL() :type(quark_prop_parameter_obj), pointer
wavefunc(:) => NULL() :type(wavefunc_param_obj), pointer
config_prof :type(config_profile_obj)
config_name :character(len=CHARLEN)
config_path :character(len=CHARLEN)
fname :character(len=CHARLEN)
input_fname :character(len=CHARLEN)
cwd :character(len=CHARLEN)
job_id :character(len=CHARLEN)
cdate :character(len=CHARLEN)
ctime :character(len=CHARLEN)
czone :character(len=CHARLEN)
comment :character(len=CHARLEN)
str :character(len=CHARLEN)
hadron_path :character(len=CHARLEN)
num_quark :integer
num_wave :integer
ini_traj :integer
end_traj :integer
traj_skip :integer
traj :integer
solver_log :type(logging_obj), pointer
run_time :type(timer_obj)

Original external subprogram is main_hadron_class#main_hadron_obj

main_hadron_obj
Derived Type :
u => NULL() :type(gvfield_dd_wg_obj), pointer
quark_parameter(:) => NULL() :type(quark_prop_parameter_obj), pointer
wavefunc(:) => NULL() :type(wavefunc_param_obj), pointer
config_prof :type(config_profile_obj)
config_name :character(len=CHARLEN)
config_path :character(len=CHARLEN)
fname :character(len=CHARLEN)
input_fname :character(len=CHARLEN)
cwd :character(len=CHARLEN)
job_id :character(len=CHARLEN)
cdate :character(len=CHARLEN)
ctime :character(len=CHARLEN)
czone :character(len=CHARLEN)
comment :character(len=CHARLEN)
str :character(len=CHARLEN)
hadron_path :character(len=CHARLEN)
num_quark :integer
num_wave :integer
ini_traj :integer
end_traj :integer
traj_skip :integer
traj :integer
solver_log :type(logging_obj), pointer
run_time :type(timer_obj)

Original external subprogram is main_hadron_class#main_hadron_obj

main_hadron_obj
Derived Type :
u => NULL() :type(gvfield_dd_wg_obj), pointer
quark_parameter(:) => NULL() :type(quark_prop_parameter_obj), pointer
wavefunc(:) => NULL() :type(wavefunc_param_obj), pointer
config_prof :type(config_profile_obj)
config_name :character(len=CHARLEN)
config_path :character(len=CHARLEN)
fname :character(len=CHARLEN)
input_fname :character(len=CHARLEN)
cwd :character(len=CHARLEN)
job_id :character(len=CHARLEN)
cdate :character(len=CHARLEN)
ctime :character(len=CHARLEN)
czone :character(len=CHARLEN)
comment :character(len=CHARLEN)
str :character(len=CHARLEN)
hadron_path :character(len=CHARLEN)
num_quark :integer
num_wave :integer
ini_traj :integer
end_traj :integer
traj_skip :integer
traj :integer
solver_log :type(logging_obj), pointer
run_time :type(timer_obj)

Original external subprogram is main_hadron_class#main_hadron_obj

main_hadron_obj
Derived Type :
u => NULL() :type(gvfield_dd_wg_obj), pointer
quark_parameter(:) => NULL() :type(quark_prop_parameter_obj), pointer
wavefunc(:) => NULL() :type(wavefunc_param_obj), pointer
config_prof :type(config_profile_obj)
config_name :character(len=CHARLEN)
config_path :character(len=CHARLEN)
fname :character(len=CHARLEN)
input_fname :character(len=CHARLEN)
cwd :character(len=CHARLEN)
job_id :character(len=CHARLEN)
cdate :character(len=CHARLEN)
ctime :character(len=CHARLEN)
czone :character(len=CHARLEN)
comment :character(len=CHARLEN)
str :character(len=CHARLEN)
hadron_path :character(len=CHARLEN)
num_quark :integer
num_wave :integer
ini_traj :integer
end_traj :integer
traj_skip :integer
traj :integer
solver_log :type(logging_obj), pointer
run_time :type(timer_obj)

Original external subprogram is main_hadron_class#main_hadron_obj

main_hadron_obj
Derived Type :
u => NULL() :type(vfield_gluon_wg), pointer
quark_parameter(:) => NULL() :type(qprop_params), pointer
wavefunc(:) => NULL() :type(src_wavefunc_obj), pointer
config_prof => NULL() :type(config_profile_obj), pointer
config_name :character(len=CHARLEN)
config_path :character(len=CHARLEN)
fname :character(len=CHARLEN)
input_fname :character(len=CHARLEN)
cwd :character(len=CHARLEN)
job_id :character(len=CHARLEN)
cdate :character(len=CHARLEN)
ctime :character(len=CHARLEN)
czone :character(len=CHARLEN)
comment :character(len=CHARLEN)
str :character(len=CHARLEN)
hadron_path :character(len=CHARLEN)
num_quark :integer
num_wave :integer
ini_traj :integer
end_traj :integer
traj_skip :integer
traj :integer
solver_log => NULL() :type(logfile), pointer
run_time :type(timer)

Hadron measurement parameters

Original external subprogram is main_hadron_class#main_hadron_obj

main_hadron_obj
Derived Type :
u => NULL() :type(vfield_gluon_wg), pointer
quark_parameter(:) => NULL() :type(qprop_params), pointer
wavefunc(:) => NULL() :type(src_wavefunc_obj), pointer
config_prof => NULL() :type(config_profile_obj), pointer
config_name :character(len=CHARLEN)
config_path :character(len=CHARLEN)
fname :character(len=CHARLEN)
input_fname :character(len=CHARLEN)
cwd :character(len=CHARLEN)
job_id :character(len=CHARLEN)
cdate :character(len=CHARLEN)
ctime :character(len=CHARLEN)
czone :character(len=CHARLEN)
comment :character(len=CHARLEN)
str :character(len=CHARLEN)
hadron_path :character(len=CHARLEN)
num_quark :integer
num_wave :integer
ini_traj :integer
end_traj :integer
traj_skip :integer
traj :integer
solver_log => NULL() :type(logfile), pointer
run_time :type(timer)

Hadron measurement parameters

Original external subprogram is main_hadron_class#main_hadron_obj

main_hadron_obj
Derived Type :
u => NULL() :type(vfield_gluon_wg), pointer
quark_parameter(:) => NULL() :type(qprop_params), pointer
wavefunc(:) => NULL() :type(src_wavefunc_obj), pointer
config_prof => NULL() :type(config_profile_obj), pointer
config_name :character(len=CHARLEN)
config_path :character(len=CHARLEN)
fname :character(len=CHARLEN)
input_fname :character(len=CHARLEN)
cwd :character(len=CHARLEN)
job_id :character(len=CHARLEN)
cdate :character(len=CHARLEN)
ctime :character(len=CHARLEN)
czone :character(len=CHARLEN)
comment :character(len=CHARLEN)
str :character(len=CHARLEN)
hadron_path :character(len=CHARLEN)
num_quark :integer
num_wave :integer
ini_traj :integer
end_traj :integer
traj_skip :integer
traj :integer
solver_log => NULL() :type(logfile), pointer
run_time :type(timer)

Hadron measurement parameters

Original external subprogram is main_hadron_class#main_hadron_obj

main_singlet_obj
Derived Type :
hadrons :type(main_hadron_obj)
random_number_seed =1 :integer
: stochastic trace estimator, noise seed
nnoise =1 :integer
: stochastic trace estimator, noise number
seed_path :character(len=CHARLEN)
seed_name :character(len=CHARLEN)
fft_time :type(timer_obj)
main_singlet_obj
Derived Type :
hadrons :type(main_hadron_obj)
singlet_parameter_file :character(len=CHARLEN)
seed_fpath :character(len=CHARLEN)
seed_fname :character(len=CHARLEN)
run_number =0 :integer
: run number
random_number_seed =1 :integer
: stochastic trace estimator, noise seed
nnoise =1 :integer
: stochastic trace estimator, noise number
idummy1 :integer

singlet meson measurement parameters

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

[Source]

subroutine new_main_singlet(this)
  implicit none
  type(main_singlet_obj), intent(inout) :: this

  call new(this%hadrons)
  call new(this%fft_time)
  this%seed_path=""
  this%seed_name="singlet_seed."

  return
end subroutine
Subroutine :
this :type(main_singlet_obj), intent(inout)

[Source]

subroutine new_main_singlet(this)
  implicit none
  type(main_singlet_obj), intent(inout) :: this

  call new(this%hadrons)
  call new(this%fft_time)
  this%seed_path=""
  this%seed_name="singlet_seed."

  return
end subroutine
Subroutine :
this :type(main_singlet_obj), intent(inout)

[Source]

subroutine print_main_singlet(this)
  implicit none
  type(main_singlet_obj), intent(inout) :: this

  call print(this%hadrons)

  if (nodeid==0) then
    write(*,'(80("="))')
    write(*,'("   Seed Save path :"A)')TRIM(this%seed_path)
    write(*,'("   Seed Save name :"A)')TRIM(this%seed_name)
    write(*,'(80("="))')
  endif
  
  return
end subroutine
Subroutine :
this :type(main_singlet_obj), intent(inout)

[Source]

subroutine print_main_singlet(this)
  implicit none
  type(main_singlet_obj), intent(inout) :: this

  call print(this%hadrons)

  if (nodeid==0) then
    write(*,'(80("="))')
    write(*,'("   Seed Save path :"A)')TRIM(this%seed_path)
    write(*,'("   Seed Save name :"A)')TRIM(this%seed_name)
    write(*,'(80("="))')
  endif
  
  return
end subroutine
Subroutine :
iout :integer, intent(in)
this :type(main_singlet_obj), intent(inout)

[Source]

subroutine read_main_singlet(iout,this)
  implicit none
  integer, intent(in) :: iout
  type(main_singlet_obj), intent(inout) :: this

  call read(iout,this%hadrons)

  if (nodeid == 0) then
    read(iout,*)
    read(iout,*)this%random_number_seed
    read(iout,'(A)')this%seed_path
    read(iout,'(A)')this%seed_name
    read(iout,'(A)')this%nnoise
    close(iout)
  endif

  if (NPU > 1) then
    call comlib_bcast(this%random_number_seed,0)
    call comlib_bcast(this%seed_path,0)
    call comlib_bcast(this%seed_name,0)
    call comlib_bcast(this%nnoise,0)
  endif

  return
end subroutine
Subroutine :
iout :integer, intent(in)
this :type(main_singlet_obj), intent(inout)

[Source]

subroutine read_main_singlet(iout,this)
  implicit none
  integer, intent(in) :: iout
  type(main_singlet_obj), intent(inout) :: this

  call read(iout,this%hadrons)

  if (nodeid == 0) then
    read(iout,*)
    read(iout,*)this%random_number_seed
    read(iout,'(A)')this%seed_path
    read(iout,'(A)')this%seed_name
    read(iout,'(A)')this%nnoise
    close(iout)
  endif

  if (NPU > 1) then
    call comlib_bcast(this%random_number_seed,0)
    call comlib_bcast(this%seed_path,0)
    call comlib_bcast(this%seed_name,0)
    call comlib_bcast(this%nnoise,0)
  endif

  return
end subroutine
Subroutine :
this :type(main_singlet_obj), intent(inout)

[Source]

subroutine save_main_singlet(this)
  use file_tools_class
  use hmc_status_class, only : fname_cont
  implicit none
  type(main_singlet_obj), intent(inout) :: this
  character(len=CHARLEN) :: fname

!=====================================
! Save Random Seed
!=====================================
  fname = fname_cont(this%run_number,this%seed_fpath,this%seed_fname)
  m_seed_out = search_free_file_unit()
  open(m_seed_out,file=fname,status='unknown',form='unformatted',action='write')
  call save(m_rand,m_seed_out)
  close(m_seed_out)

!=====================================
! Save Input Parameters
!=====================================
  if (nodeid == 0) then
    m_js_out = search_free_file_unit()
    open(m_js_out,file=TRIM(this%singlet_parameter_file),form='formatted',status='old')
    write(m_js_out,*)this%run_number
    write(m_js_out,*)this%random_number_seed
    write(m_js_out,'(A)')TRIM(this%seed_fpath)
    write(m_js_out,'(A)')TRIM(this%seed_fname)
    write(m_js_out,*)this%nnoise
    close(m_js_out)
  endif

  return
end subroutine
Subroutine :
u :type(vfield_gluon_wg), intent(inout)
itx :integer, intent(in)
ity :integer, intent(in)
itz :integer, intent(in)

This is a test routine for lattice translational symmetry. This shift the corrdinate oringin of the gauge link field. Do not use this production run.

[Source]

subroutine shift(u,itx,ity,itz)
!
! This is a test routine for lattice translational symmetry.
! This shift the corrdinate oringin of the gauge link field.
! Do not use this production run.
!
  implicit none
  type(vfield_gluon_wg), intent(inout) :: u
  integer, intent(in) :: itx,ity,itz
  type(sfield_gluon_wg), allocatable :: w
  integer :: idir,ix,iy,iz,mu,Nshift(1:NDIM-1)
  allocate(w)
  call new(w)
  call copy_boundary(u)

  Nshift(1) = itx
  Nshift(2) = ity
  Nshift(3) = itz

  do idir = 1,NDIM-1
  do ix=1,Nshift(idir)-1
    do mu=1,NDIM
      call assign_shift(w%eo(0),u%eo(1)%mu(mu),-idir)
      call assign_shift(w%eo(1),u%eo(0)%mu(mu),-idir)
      call assign(u%eo(0)%mu(mu),w%eo(0))
      call assign(u%eo(1)%mu(mu),w%eo(1))
    enddo
    call copy_boundary(u)
  enddo
  enddo

  deallocate(w)
  return
end subroutine