Class fix_gauge_class
In: FixGauge_v1.0/fix_gauge_class.F90
FixGauge/fix_gauge_class.F90
comlib lattice_class error_class timer_class logfile_class field_gauge_class hmc_gluon_class file_tools_class print_status_class fix_gauge_class dot/f_48.png

Methods

Included Modules

comlib lattice_class error_class timer_class logfile_class field_gauge_class hmc_gluon_class file_tools_class print_status_class

Public Instance methods

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

[Source]

subroutine delete_gfix(this)
  implicit none
  type(fix_gauge), intent(inout) :: this
  type(lattice_world) :: lattice
  call delete(this%reunit_log)
  call delete(lattice) 
  return
end subroutine
Subroutine :
this :type(fix_gauge), intent(inout)

[Source]

subroutine delete_gfix(this)
  implicit none
  type(fix_gauge), intent(inout) :: this
  type(lattice_world) :: lattice
  call delete(this%reunit_log)
  call delete(lattice) 
  return
end subroutine
fix_gauge
Derived Type :
job_id :character(len=CHARLEN)
: JOB ID
input_fname :character(len=CHARLEN)
: input file name
cwd :character(len=CHARLEN)
: current working dir.
fpath_in :character(len=CHARLEN)
: input gauge file path
fhead_in :character(len=CHARLEN)
: input gauge file name
fpath_out :character(len=CHARLEN)
: output gauge file path
fhead_out :character(len=CHARLEN)
: output gauge file name
reunit_log_fname = "gfix_reunit." :character(len=CHARLEN)
: reunitarization log file
eps1 :real(DP)
: Stopping condition for derivative of gauge fixing functional.
eps2 :real(DP)
: Stopping condition for relative diff. of gauge fixing functional.
omega :real(DP)
: Over Relaxation parameter for Mino‘s algorithm.
omega_new :real(DP)
: omega for retry.
idim_max :integer
: 0: don‘t gauge fix, 3 : Coulomb gauge, 4 : Landau gauge.
iter_max :integer
: Max. number of iteration for gauge fixing
isweep_CM :integer
: Number of Cabibbo-Marinari sweep par site. (default=1)
iter_OR_begin :integer
: Number of iteration to begin Mino‘s OR steps.
iter_conv_check_begin :integer
: After iteration exceeds iter_check, convergence check begins.
iter_print_skip :integer
: The iteration history is print out every iter_print_skip after iter_conv_check.
iter_reunit_skip :integer
: every iter_reunit_skip, config. is reunitarized.
itry_OR_max :integer
: max number to retry Mino‘s OR.
iter_inc_OR_begin :integer
: incremant of iter_OR at retry.
itry_read :integer
: 1: read configuration at retry, others: don‘t read.
idummy1 :integer
idummy2 :integer
reunit_log :type(logfile)
tot_time :type(timer)
io_time :type(timer)
gfix_time :type(timer)

job paramters for Ggauge Fixing Coulimb/Landau gauge fixing

fix_gauge
Derived Type :
job_id :character(len=CHARLEN)
: JOB ID
input_fname :character(len=CHARLEN)
: input file name
cwd :character(len=CHARLEN)
: current working dir.
fpath_in :character(len=CHARLEN)
: input gauge file path
fhead_in :character(len=CHARLEN)
: input gauge file name
fpath_out :character(len=CHARLEN)
: output gauge file path
fhead_out :character(len=CHARLEN)
: output gauge file name
reunit_log_fname = "gfix_reunit." :character(len=CHARLEN)
: reunitarization log file
eps1 :real(DP)
: Stopping condition for derivative of gauge fixing functional.
eps2 :real(DP)
: Stopping condition for relative diff. of gauge fixing functional.
omega :real(DP)
: Over Relaxation parameter for Mino‘s algorithm.
omega_new :real(DP)
: omega for retry.
idim_max :integer
: 0: don‘t gauge fix, 3 : Coulomb gauge, 4 : Landau gauge.
iter_max :integer
: Max. number of iteration for gauge fixing
isweep_CM :integer
: Number of Cabibbo-Marinari sweep par site. (default=1)
iter_OR_begin :integer
: Number of iteration to begin Mino‘s OR steps.
iter_conv_check_begin :integer
: After iteration exceeds iter_check, convergence check begins.
iter_print_skip :integer
: The iteration history is print out every iter_print_skip after iter_conv_check.
iter_reunit_skip :integer
: every iter_reunit_skip, config. is reunitarized.
itry_OR_max :integer
: max number to retry Mino‘s OR.
iter_inc_OR_begin :integer
: incremant of iter_OR at retry.
itry_read :integer
: 1: read configuration at retry, others: don‘t read.
idummy1 :integer
idummy2 :integer
reunit_log :type(logfile)
tot_time :type(timer)
io_time :type(timer)
gfix_time :type(timer)

job paramters for Ggauge Fixing Coulimb/Landau gauge fixing

Function :
fname :character(CHARLEN)
fpath :character(*), intent(in)
fhead :character(*), intent(in)

[Source]

function fname_measure(fpath,fhead) result(fname)
  implicit none
  character(CHARLEN) :: fname
  character(*), intent(in) :: fpath,fhead
  character(CHARLEN) :: fbuff,fdir
  integer :: i

  fname = REPEAT(' ',LEN(fname))
  fbuff = REPEAT(' ',LEN(fbuff))
  fdir = fpath
  i = LEN_TRIM(fdir)

  if (fdir(i:i) /= '/') then
    fdir = TRIM(ADJUSTL(fdir))//'/'
  endif

  write(fbuff,'(".x",z1,"y",z1,"z",z1)')(ipsite(i),i=1,NDIM-1)
  fname = TRIM(TRIM(ADJUSTL(fdir))//TRIM(ADJUSTL(fhead)))//TRIM(ADJUSTL(fbuff))
  
  return
end function
Function :
fname :character(CHARLEN)
fpath :character(*), intent(in)
fhead :character(*), intent(in)

[Source]

function fname_measure(fpath,fhead) result(fname)
  implicit none
  character(CHARLEN) :: fname
  character(*), intent(in) :: fpath,fhead
  character(CHARLEN) :: fbuff,fdir
  integer :: i

  fname = REPEAT(' ',LEN(fname))
  fbuff = REPEAT(' ',LEN(fbuff))
  fdir = fpath
  i = LEN_TRIM(fdir)

  if (fdir(i:i) /= '/') then
    fdir = TRIM(ADJUSTL(fdir))//'/'
  endif

  write(fbuff,'(".x",z1,"y",z1,"z",z1)')(ipsite(i),i=1,NDIM-1)
  fname = TRIM(TRIM(ADJUSTL(fdir))//TRIM(ADJUSTL(fhead)))//TRIM(ADJUSTL(fbuff))
  
  return
end function
Subroutine :
this :type(fix_gauge), intent(inout)

[Source]

subroutine new_gfix(this)
  implicit none
  type(fix_gauge), intent(inout) :: this

  type(lattice_world) :: lattice
  character(len=8)  :: cdate
  character(len=10) :: ctime

  call new(lattice)

  call new(this%tot_time)
  call tic(this%tot_time)

  call new(this%gfix_time)
  call new(this%io_time)

  this%fpath_in   = repeat(' ',len(this%fpath_in))
  this%fhead_in   = repeat(' ',len(this%fhead_in))
  this%fpath_out  = repeat(' ',len(this%fpath_out))
  this%fhead_out  = repeat(' ',len(this%fhead_out))
  this%cwd        = repeat(' ',len(this%cwd))
  this%job_id     = repeat(' ',len(this%job_id))

  call DATE_AND_TIME(date=cdate,time=ctime)
  write(this%job_id,'(A,".",A)')TRIM(ADJUSTL(cdate)),TRIM(ADJUSTL(ctime))

  if (0 == nodeid) then
    call GET_COMMAND_ARGUMENT(1,this%input_fname)
    call getcwd(this%cwd)
  endif

  if (0 == nodeid) then
    write(*,'(" DATE AND TIME :",A)')TRIM(this%job_id)
  endif

#ifndef _singlePU
  if (NPU > 1) then
    call comlib_bcast(this%input_fname,0)
    call comlib_bcast(this%cwd,0)
    call comlib_bcast(this%job_id,0)
  endif
#endif

  this%reunit_log_fname=TRIM(ADJUSTL(this%reunit_log_fname))//TRIM(ADJUSTL(this%job_id))
  call new(this%reunit_log,TRIM(ADJUSTL(this%reunit_log_fname)))

  this%eps1 = EPSILON(1.0_DP)*2
  this%eps2 = EPSILON(1.0_DP)*2
  this%omega     = 1.99_DP
  this%omega_new = 1.90_DP

  this%idim_max  = 3
  this%iter_max  = 10000
  this%isweep_CM = 1
  this%iter_OR_begin = 500
  this%iter_conv_check_begin = 200
  this%iter_print_skip   = 100
  this%iter_reunit_skip  = 200
  this%itry_OR_max       = 10
  this%iter_inc_OR_begin = 50
  this%itry_read = 1

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

[Source]

subroutine new_gfix(this)
  implicit none
  type(fix_gauge), intent(inout) :: this

  type(lattice_world) :: lattice
  character(len=8)  :: cdate
  character(len=10) :: ctime

  call new(lattice)

  call new(this%tot_time)
  call tic(this%tot_time)

  call new(this%gfix_time)
  call new(this%io_time)

  this%fpath_in   = repeat(' ',len(this%fpath_in))
  this%fhead_in   = repeat(' ',len(this%fhead_in))
  this%fpath_out  = repeat(' ',len(this%fpath_out))
  this%fhead_out  = repeat(' ',len(this%fhead_out))
  this%cwd        = repeat(' ',len(this%cwd))
  this%job_id     = repeat(' ',len(this%job_id))

  call DATE_AND_TIME(date=cdate,time=ctime)
  write(this%job_id,'(A,".",A)')TRIM(ADJUSTL(cdate)),TRIM(ADJUSTL(ctime))

  if (0 == nodeid) then
    call GET_COMMAND_ARGUMENT(1,this%input_fname)
    call getcwd(this%cwd)
  endif

  if (0 == nodeid) then
    write(*,'(" DATE AND TIME :",A)')TRIM(this%job_id)
  endif

#ifndef _singlePU
  if (NPU > 1) then
    call comlib_bcast(this%input_fname,0)
    call comlib_bcast(this%cwd,0)
    call comlib_bcast(this%job_id,0)
  endif
#endif

  this%reunit_log_fname=TRIM(ADJUSTL(this%reunit_log_fname))//TRIM(ADJUSTL(this%job_id))
  call new(this%reunit_log,TRIM(ADJUSTL(this%reunit_log_fname)))

  this%eps1 = EPSILON(1.0_DP)*2
  this%eps2 = EPSILON(1.0_DP)*2
  this%omega     = 1.99_DP
  this%omega_new = 1.90_DP

  this%idim_max  = 3
  this%iter_max  = 10000
  this%isweep_CM = 1
  this%iter_OR_begin = 500
  this%iter_conv_check_begin = 200
  this%iter_print_skip   = 100
  this%iter_reunit_skip  = 200
  this%itry_OR_max       = 10
  this%iter_inc_OR_begin = 50
  this%itry_read = 1

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

Print job parameters for Gauge Fixing (CM/OR method).

this : job parameters

[Source]

subroutine print_gfix(this)
!
! Print job parameters for Gauge Fixing (CM/OR method).
!
! this : job parameters
!
  implicit none
  type(fix_gauge), intent(inout) :: this

  if (0 == nodeid) then
    write(*,'(80("-"))')
    write(*,'("**** Lattice ****")')
    write(*,'("                Lattice Size :",4I3)')NTX,NTY,NTZ,NTT
    write(*,'("             PU Lattice Size :",4I3)')NX,NY,NZ,NT
    write(*,'("               PU Array Size :",4I3)')NDIMX,NDIMY,NDIMZ,1
    write(*,'("**** Gauge Fixing Parameters ****")')
    write(*,'("       Input conf. file path : ",A)')TRIM(this%fpath_in)
    write(*,'("       Input conf. file name : ",A)')TRIM(this%fhead_in)
    write(*,'("      Output conf. file path : ",A)')TRIM(this%fpath_out)
    write(*,'("      Output conf. file name : ",A)')TRIM(this%fhead_out)
    write(*,*)
    write(*,'("--------- Stopping Condition :")')
    write(*,'("- The program converges when both the following condition is satisfied.")')
    write(*,'("-    The successive change of the GF functional < EPS1.")')
    write(*,'("- The norm of the gradient of the GF functional < EPS2.")')
    write(*,'("                        EPS1 : ",E24.16)')this%eps1
    write(*,'("                        EPS2 : ",E24.16)')this%eps2
    write(*,*)
    write(*,'("---------- Fixing parameters :")')
    write(*,'("          OR Parameter Omega : ",E24.16)')this%omega
    write(*,'("                    IDIM_MAX : ",I3)')this%idim_max

    select case (this%idim_max)
    case (0)
      write(*,'("                             : => Do Not Fix Gauge.")')
    case (3)
      write(*,'("                             : => Couloumb Gauge Fixing.")')
    case (4)
      write(*,'("                             : =>   Landau Gauge Fixing.")')
    case default
      goto 100
    end select

    write(*,*)
    write(*,'("------- Iteration parameters :")')
    write(*,'("          Max # of Iteration : ",I10)')this%iter_max
    write(*,'(" # of Cabibbo-Marinari sweep : ",I10)')this%isweep_CM
    write(*,'("    # Iter. to start OR step : ",I10)')this%iter_OR_begin
    write(*,*)
    write(*,'("# Iter. to start Conv. Check : ",I10)')this%iter_conv_check_begin
    write(*,'("        # Skip Print History : ",I10)')this%iter_print_skip
    write(*,'("     # Skip Re-unitarization : ",I10)')this%iter_reunit_skip
    write(*,*)
    write(*,'("----------- Retry parameters :")')
    write(*,'("     Max. # of retry OR step : ",I10)')this%itry_OR_max
    write(*,'("# Iter to inclement OR start : ",I10)')this%iter_inc_OR_begin
    write(*,'("  New OR Parameter Omega_new : ",E24.16)')this%omega_new
    write(*,'(" Reload config. for retry ?  : ",I3)')this%itry_read

    select case (this%itry_read)
    case (1)
      write(*,'("                             : => Reload Config.")')
    case default
      write(*,'("                             : => Do Not Reload Config.")')
    end select

    write(*,'(80("-"))')
    write(*,*)
  endif

  return

100 continue
  call error_message(" Error in Input File, IDIM_MAX shoulr be 0, 3, or 4.")
  call error_stop(" Error Stop ! (read_param_gfix.F)")

end subroutine
Subroutine :
this :type(fix_gauge), intent(inout)

Print job parameters for Gauge Fixing (CM/OR method).

this : job parameters

[Source]

subroutine print_gfix(this)
!
! Print job parameters for Gauge Fixing (CM/OR method).
!
! this : job parameters
!
  implicit none
  type(fix_gauge), intent(inout) :: this

  if (0 == nodeid) then
    write(*,'(80("-"))')
    write(*,'("**** Lattice ****")')
    write(*,'("                Lattice Size :",4I3)')NTX,NTY,NTZ,NTT
    write(*,'("             PU Lattice Size :",4I3)')NX,NY,NZ,NT
    write(*,'("               PU Array Size :",4I3)')NDIMX,NDIMY,NDIMZ,1
    write(*,'("**** Gauge Fixing Parameters ****")')
    write(*,'("       Input conf. file path : ",A)')TRIM(this%fpath_in)
    write(*,'("       Input conf. file name : ",A)')TRIM(this%fhead_in)
    write(*,'("      Output conf. file path : ",A)')TRIM(this%fpath_out)
    write(*,'("      Output conf. file name : ",A)')TRIM(this%fhead_out)
    write(*,*)
    write(*,'("--------- Stopping Condition :")')
    write(*,'("- The program converges when both the following condition is satisfied.")')
    write(*,'("-    The successive change of the GF functional < EPS1.")')
    write(*,'("- The norm of the gradient of the GF functional < EPS2.")')
    write(*,'("                        EPS1 : ",E24.16)')this%eps1
    write(*,'("                        EPS2 : ",E24.16)')this%eps2
    write(*,*)
    write(*,'("---------- Fixing parameters :")')
    write(*,'("          OR Parameter Omega : ",E24.16)')this%omega
    write(*,'("                    IDIM_MAX : ",I3)')this%idim_max

    select case (this%idim_max)
    case (0)
      write(*,'("                             : => Do Not Fix Gauge.")')
    case (3)
      write(*,'("                             : => Couloumb Gauge Fixing.")')
    case (4)
      write(*,'("                             : =>   Landau Gauge Fixing.")')
    case default
      goto 100
    end select

    write(*,*)
    write(*,'("------- Iteration parameters :")')
    write(*,'("          Max # of Iteration : ",I10)')this%iter_max
    write(*,'(" # of Cabibbo-Marinari sweep : ",I10)')this%isweep_CM
    write(*,'("    # Iter. to start OR step : ",I10)')this%iter_OR_begin
    write(*,*)
    write(*,'("# Iter. to start Conv. Check : ",I10)')this%iter_conv_check_begin
    write(*,'("        # Skip Print History : ",I10)')this%iter_print_skip
    write(*,'("     # Skip Re-unitarization : ",I10)')this%iter_reunit_skip
    write(*,*)
    write(*,'("----------- Retry parameters :")')
    write(*,'("     Max. # of retry OR step : ",I10)')this%itry_OR_max
    write(*,'("# Iter to inclement OR start : ",I10)')this%iter_inc_OR_begin
    write(*,'("  New OR Parameter Omega_new : ",E24.16)')this%omega_new
    write(*,'(" Reload config. for retry ?  : ",I3)')this%itry_read

    select case (this%itry_read)
    case (1)
      write(*,'("                             : => Reload Config.")')
    case default
      write(*,'("                             : => Do Not Reload Config.")')
    end select

    write(*,'(80("-"))')
    write(*,*)
  endif

  return

100 continue
  call error_message(" Error in Input File, IDIM_MAX shoulr be 0, 3, or 4.")
  call error_stop(" Error Stop ! (read_param_gfix.F)")

end subroutine
Subroutine :
this :type(fix_gauge), intent(inout)

Print out job statistics

[Source]

subroutine print_stat_gfix(this)
!
! Print out job statistics
!
  implicit none
  type(fix_gauge), intent(inout) :: this
  real(DP) :: etime_gfix, etime_io, etime_copy, etime_tot

  etime_gfix = get_elapse(this%gfix_time)
  etime_io   = get_elapse(this%io_time)
  etime_copy = get_elapse(copy_sfg_time)

  call toc(this%tot_time)
  etime_tot = get_elapse(this%tot_time)

  if (0 == nodeid) then
    write(*,'(80("-"))')
    write(*,'("  Statistics par 1PU")')
    write(*,'("                 Total time (sec) :",F12.4)') etime_tot
    write(*,'("                    IO time (sec) :",F12.4," (",F8.4," %)")') etime_io  ,100*etime_io  /etime_tot
    write(*,'("          Gauge Fixing time (sec) :",F12.4," (",F8.4," %)")') etime_gfix,100*etime_gfix/etime_tot
    write(*,'("                copy_u time (sec) :",F12.4," (",F8.4," %)")') etime_copy,100*etime_copy/etime_tot
    write(*,'(80("="))')
  endif

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

Print out job statistics

[Source]

subroutine print_stat_gfix(this)
!
! Print out job statistics
!
  implicit none
  type(fix_gauge), intent(inout) :: this
  real(DP) :: etime_gfix, etime_io, etime_copy, etime_tot

  etime_gfix = get_elapse(this%gfix_time)
  etime_io   = get_elapse(this%io_time)
  etime_copy = get_elapse(copy_sfg_time)

  call toc(this%tot_time)
  etime_tot = get_elapse(this%tot_time)

  if (0 == nodeid) then
    write(*,'(80("-"))')
    write(*,'("  Statistics par 1PU")')
    write(*,'("                 Total time (sec) :",F12.4)') etime_tot
    write(*,'("                    IO time (sec) :",F12.4," (",F8.4," %)")') etime_io  ,100*etime_io  /etime_tot
    write(*,'("          Gauge Fixing time (sec) :",F12.4," (",F8.4," %)")') etime_gfix,100*etime_gfix/etime_tot
    write(*,'("                copy_u time (sec) :",F12.4," (",F8.4," %)")') etime_copy,100*etime_copy/etime_tot
    write(*,'(80("="))')
  endif

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

Read job parameters for Gauge Fixing (CM/OR method). The job parameters are read from input file with name "jobfile".

 this : job parameters

[Source]

subroutine read_gfix(this)
!
! Read job parameters for Gauge Fixing (CM/OR method).
! The job parameters are read from input file with name "jobfile".
!
!  this : job parameters
!
  use file_tools_class
  implicit none
  type(fix_gauge), intent(inout) :: this
  integer :: iout

  call tic(this%io_time)

  iout = search_free_file_unit()
  if (0 == nodeid) then
    open(iout,file=this%input_fname,action='read',status='old',form='formatted')
    read(iout,*)
    read(iout,'(A)') this%fpath_in    ! input  config file path
    read(iout,'(A)') this%fhead_in    ! input  config file name head
    read(iout,*)
    read(iout,'(A)') this%fpath_out   ! output config file path
    read(iout,'(A)') this%fhead_out   ! output config file name head
    read(iout,*)
    read(iout,*) this%eps1
    read(iout,*) this%eps2
    read(iout,*) this%omega
    read(iout,*)
    read(iout,*) this%idim_max
    read(iout,*)
    read(iout,*) this%iter_max
    read(iout,*) this%isweep_CM
    read(iout,*) this%iter_OR_begin
    read(iout,*)
    read(iout,*) this%iter_conv_check_begin
    read(iout,*) this%iter_print_skip
    read(iout,*) this%iter_reunit_skip
    read(iout,*)
    read(iout,*) this%itry_OR_max
    read(iout,*) this%iter_inc_OR_begin
    read(iout,*) this%omega_new
    read(iout,*) this%itry_read
    close(iout)
  endif

  if (this%omega >= 2.0_DP) then
    this%omega=1.99_DP
    if (0 == nodeid) then
      write(*,'(" OR Omega should be < 2.")')
      write(*,'(" Reset,  omega = ",F24.16)') this%omega
    endif
  endif

  if (this%iter_reunit_skip <= 0) then
    this%iter_reunit_skip = 100 
    if (0 == nodeid) then
      write(*,'(" Re-Unitarization is preferred.")')
      write(*,'(" Reset,  iter_reunit_skip = ",I4)') this%iter_reunit_skip
    endif
  endif

#ifndef _singlePU
  if (NPU > 1) then
    call comlib_bcast(this%fpath_in,0)
    call comlib_bcast(this%fhead_in,0)
    call comlib_bcast(this%fpath_out,0)
    call comlib_bcast(this%fhead_out,0)
    call comlib_bcast(this%eps1,0)
    call comlib_bcast(this%eps2,0)
    call comlib_bcast(this%omega,0)
    call comlib_bcast(this%idim_max,0)
    call comlib_bcast(this%iter_max,0)
    call comlib_bcast(this%isweep_CM,0)
    call comlib_bcast(this%iter_OR_begin,0)
    call comlib_bcast(this%iter_conv_check_begin,0)
    call comlib_bcast(this%iter_print_skip,0)
    call comlib_bcast(this%iter_reunit_skip,0)
    call comlib_bcast(this%itry_OR_max,0)
    call comlib_bcast(this%iter_inc_OR_begin,0)
    call comlib_bcast(this%omega_new,0)
    call comlib_bcast(this%itry_read,0)
  endif
#endif

  call toc(this%io_time)

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

Read job parameters for Gauge Fixing (CM/OR method). The job parameters are read from input file with name "jobfile".

 this : job parameters

[Source]

subroutine read_gfix(this)
!
! Read job parameters for Gauge Fixing (CM/OR method).
! The job parameters are read from input file with name "jobfile".
!
!  this : job parameters
!
  use file_tools_class
  implicit none
  type(fix_gauge), intent(inout) :: this
  integer :: iout

  call tic(this%io_time)

  iout = search_free_file_unit()
  if (0 == nodeid) then
    open(iout,file=this%input_fname,action='read',status='old',form='formatted')
    read(iout,*)
    read(iout,'(A)') this%fpath_in    ! input  config file path
    read(iout,'(A)') this%fhead_in    ! input  config file name head
    read(iout,*)
    read(iout,'(A)') this%fpath_out   ! output config file path
    read(iout,'(A)') this%fhead_out   ! output config file name head
    read(iout,*)
    read(iout,*) this%eps1
    read(iout,*) this%eps2
    read(iout,*) this%omega
    read(iout,*)
    read(iout,*) this%idim_max
    read(iout,*)
    read(iout,*) this%iter_max
    read(iout,*) this%isweep_CM
    read(iout,*) this%iter_OR_begin
    read(iout,*)
    read(iout,*) this%iter_conv_check_begin
    read(iout,*) this%iter_print_skip
    read(iout,*) this%iter_reunit_skip
    read(iout,*)
    read(iout,*) this%itry_OR_max
    read(iout,*) this%iter_inc_OR_begin
    read(iout,*) this%omega_new
    read(iout,*) this%itry_read
    close(iout)
  endif

  if (this%omega >= 2.0_DP) then
    this%omega=1.99_DP
    if (0 == nodeid) then
      write(*,'(" OR Omega should be < 2.")')
      write(*,'(" Reset,  omega = ",F24.16)') this%omega
    endif
  endif

  if (this%iter_reunit_skip <= 0) then
    this%iter_reunit_skip = 100 
    if (0 == nodeid) then
      write(*,'(" Re-Unitarization is preferred.")')
      write(*,'(" Reset,  iter_reunit_skip = ",I4)') this%iter_reunit_skip
    endif
  endif

#ifndef _singlePU
  if (NPU > 1) then
    call comlib_bcast(this%fpath_in,0)
    call comlib_bcast(this%fhead_in,0)
    call comlib_bcast(this%fpath_out,0)
    call comlib_bcast(this%fhead_out,0)
    call comlib_bcast(this%eps1,0)
    call comlib_bcast(this%eps2,0)
    call comlib_bcast(this%omega,0)
    call comlib_bcast(this%idim_max,0)
    call comlib_bcast(this%iter_max,0)
    call comlib_bcast(this%isweep_CM,0)
    call comlib_bcast(this%iter_OR_begin,0)
    call comlib_bcast(this%iter_conv_check_begin,0)
    call comlib_bcast(this%iter_print_skip,0)
    call comlib_bcast(this%iter_reunit_skip,0)
    call comlib_bcast(this%itry_OR_max,0)
    call comlib_bcast(this%iter_inc_OR_begin,0)
    call comlib_bcast(this%omega_new,0)
    call comlib_bcast(this%itry_read,0)
  endif
#endif

  call toc(this%io_time)

  return
end subroutine
Subroutine :
fpath :character(len=CHARLEN), intent(in)
fhead :character(len=CHARLEN), intent(in)
u :type(vfield_gluon_wg), intent(inout)
reunit_log :type(logfile), intent(inout)
plq0 :real(DP), intent(out)

[Source]

subroutine read_config(fpath,fhead,u,reunit_log,plq0)
  use file_tools_class
  use print_status_class
  implicit none
  character(len=CHARLEN), intent(in)    :: fpath,fhead
  type(vfield_gluon_wg),  intent(inout) :: u
  type(logfile),          intent(inout) :: reunit_log
  real(DP),               intent(out)   :: plq0
  character(len=CHARLEN) :: fname, str
  real(DP) :: plq1,dq
  integer :: cNTX,cNTY,cNTZ,cNTT
  integer :: cNDIMX,cNDIMY,cNDIMZ
  integer :: iout

  fname = fname_measure(fpath,fhead)
  iout = search_free_file_unit()

  if (0 == nodeid) then
    write(*,'(80("-"))')
  endif
  write(str,'("      READ config : ",A)')TRIM(ADJUSTL(fname))
  call print_status(str)

  open(iout,file=TRIM(ADJUSTL(fname)),status='old',form='unformatted')
  read(iout)u
  read(iout)cNTX,cNTY,cNTZ,cNTT
  read(iout)cNDIMX,cNDIMY,cNDIMZ
  read(iout)plq0
  close(iout)

  call copy_boundary(u)
  call reunitarize(u,reunit_log)
  call copy_boundary(u)
  call plaquette(u,plq1)
  dq = ABS(plq1-plq0)/plq0

  if (0 == nodeid) then
    write(*,'("             PLQ0 : ",E24.15)')plq0
    write(*,'("             PLQ1 : ",E24.15)')plq1
    write(*,'(" |PLQ0-PLQ1|/PLQ0 : ",E24.15)')dq
    write(*,'(80("-"))')
  endif

  if (dq > PLQ_TOL) then
    write(str,'(" PLQ is differ ! STOP. (dq > PLQ_TOL =",E24.15,")")') PLQ_TOL
    call error_stop(TRIM(str))
  endif

  return
end subroutine
Subroutine :
fpath :character(len=CHARLEN), intent(in)
fhead :character(len=CHARLEN), intent(in)
u :type(vfield_gluon_wg), intent(inout)
reunit_log :type(logfile), intent(inout)
plq0 :real(DP), intent(out)

[Source]

subroutine read_config(fpath,fhead,u,reunit_log,plq0)
  use file_tools_class
  use print_status_class
  implicit none
  character(len=CHARLEN), intent(in)    :: fpath,fhead
  type(vfield_gluon_wg),  intent(inout) :: u
  type(logfile),          intent(inout) :: reunit_log
  real(DP),               intent(out)   :: plq0
  character(len=CHARLEN) :: fname, str
  real(DP) :: plq1,dq
  integer :: cNTX,cNTY,cNTZ,cNTT
  integer :: cNDIMX,cNDIMY,cNDIMZ
  integer :: iout

  fname = fname_measure(fpath,fhead)
  iout = search_free_file_unit()

  if (0 == nodeid) then
    write(*,'(80("-"))')
  endif
  write(str,'("      READ config : ",A)')TRIM(ADJUSTL(fname))
  call print_status(str)

  open(iout,file=TRIM(ADJUSTL(fname)),status='old',form='unformatted')
  read(iout)u
  read(iout)cNTX,cNTY,cNTZ,cNTT
  read(iout)cNDIMX,cNDIMY,cNDIMZ
  read(iout)plq0
  close(iout)

  call copy_boundary(u)
  call reunitarize(u,reunit_log)
  call copy_boundary(u)
  call plaquette(u,plq1)
  dq = ABS(plq1-plq0)/plq0

  if (0 == nodeid) then
    write(*,'("             PLQ0 : ",E24.15)')plq0
    write(*,'("             PLQ1 : ",E24.15)')plq1
    write(*,'(" |PLQ0-PLQ1|/PLQ0 : ",E24.15)')dq
    write(*,'(80("-"))')
  endif

  if (dq > PLQ_TOL) then
    write(str,'(" PLQ is differ ! STOP. (dq > PLQ_TOL =",E24.15,")")') PLQ_TOL
    call error_stop(TRIM(str))
  endif

  return
end subroutine
Subroutine :
this :type(fix_gauge), intent(inout)
 Run gauge fixing

[Source]

subroutine run_gfix(this)
!
!  Run gauge fixing
!
  implicit none
  type(fix_gauge), intent(inout) :: this

  type(vfield_gluon_wg), pointer  :: u
  integer :: ires,itry
  real(DP) :: plq,plq0

  allocate(u)
  call new(u)


  call tic(this%io_time)
  call read_config(this%fpath_in,this%fhead_in,u,this%reunit_log,plq0)
  call toc(this%io_time)

  call print_config(u)

  if (this%idim_max /= 0) then

    call gfix(this,u,plq,ires)

    if (this%iter_OR_begin < this%iter_max) then
      !--------------------------------------
      ! retry gauge fixing when normal
      ! gauge fixing fails to converge.
      !--------------------------------------
      itry = 0

      do while ((ires == 0) .AND. (itry < this%itry_OR_max))
        itry = itry + 1
        this%iter_OR_begin         = this%iter_OR_begin         + this%iter_inc_OR_begin
        this%iter_max              = this%iter_max              + this%iter_inc_OR_begin
        this%iter_conv_check_begin = this%iter_conv_check_begin + this%iter_inc_OR_begin
        this%omega                 = this%omega_new

        if (0 == nodeid) then
          write(6,*)
          write(6,'(" Normal Gauge Fixing is faild within the given job parameters.")')
          write(6,'(" Retry Gauge Fixing changing parameters.")')
          write(6,'("                  # of Retry : ",I9)')itry
          write(6,'("         Max. # of iteration : ",I9)') this%iter_max
          write(6,'("          Start iter. for OR : ",I9)') this%iter_OR_begin
          write(6,'(" Start iter. for Check Conv. : ",I9)') this%iter_conv_check_begin
          write(6,'("      New OR parameter Omega : ",E24.16)') this%omega
        endif

        if (this%itry_read == 1) then
          !---------------------------------------
          ! Reload gauge configuration for retry.
          !---------------------------------------
          call tic(this%io_time)
          call read_config(this%fpath_in,this%fhead_in,u,this%reunit_log,plq0)
          call toc(this%io_time)
        endif

        call gfix(this,u,plq,ires)

      enddo
    endif

  endif

  call tic(this%io_time)
  call print_config(u)

  !-----------------------------------
  ! save for measuremnt
  !-----------------------------------
  call save_config(this%fpath_out,this%fhead_out,u,plq0)
  call toc(this%io_time)

  deallocate(u)

  return
end subroutine
Subroutine :
this :type(fix_gauge), intent(inout)
 Run gauge fixing

[Source]

subroutine run_gfix(this)
!
!  Run gauge fixing
!
  implicit none
  type(fix_gauge), intent(inout) :: this

  type(vfield_gluon_wg), pointer  :: u
  integer :: ires,itry
  real(DP) :: plq,plq0

  allocate(u)
  call new(u)


  call tic(this%io_time)
  call read_config(this%fpath_in,this%fhead_in,u,this%reunit_log,plq0)
  call toc(this%io_time)

  call print_config(u)

  if (this%idim_max /= 0) then

    call gfix(this,u,plq,ires)

    if (this%iter_OR_begin < this%iter_max) then
      !--------------------------------------
      ! retry gauge fixing when normal
      ! gauge fixing fails to converge.
      !--------------------------------------
      itry = 0

      do while ((ires == 0) .AND. (itry < this%itry_OR_max))
        itry = itry + 1
        this%iter_OR_begin         = this%iter_OR_begin         + this%iter_inc_OR_begin
        this%iter_max              = this%iter_max              + this%iter_inc_OR_begin
        this%iter_conv_check_begin = this%iter_conv_check_begin + this%iter_inc_OR_begin
        this%omega                 = this%omega_new

        if (0 == nodeid) then
          write(6,*)
          write(6,'(" Normal Gauge Fixing is faild within the given job parameters.")')
          write(6,'(" Retry Gauge Fixing changing parameters.")')
          write(6,'("                  # of Retry : ",I9)')itry
          write(6,'("         Max. # of iteration : ",I9)') this%iter_max
          write(6,'("          Start iter. for OR : ",I9)') this%iter_OR_begin
          write(6,'(" Start iter. for Check Conv. : ",I9)') this%iter_conv_check_begin
          write(6,'("      New OR parameter Omega : ",E24.16)') this%omega
        endif

        if (this%itry_read == 1) then
          !---------------------------------------
          ! Reload gauge configuration for retry.
          !---------------------------------------
          call tic(this%io_time)
          call read_config(this%fpath_in,this%fhead_in,u,this%reunit_log,plq0)
          call toc(this%io_time)
        endif

        call gfix(this,u,plq,ires)

      enddo
    endif

  endif

  call tic(this%io_time)
  call print_config(u)

  !-----------------------------------
  ! save for measuremnt
  !-----------------------------------
  call save_config(this%fpath_out,this%fhead_out,u,plq0)
  call toc(this%io_time)

  deallocate(u)

  return
end subroutine
Subroutine :
fpath :character(len=CHARLEN), intent(in)
fhead :character(len=CHARLEN), intent(in)
u :type(vfield_gluon_wg), intent(in)
plq0 :real(DP), intent(in)

[Source]

subroutine save_config(fpath,fhead,u,plq0)
  use file_tools_class
  use print_status_class
  implicit none
  character(len=CHARLEN), intent(in) :: fpath,fhead
  type(vfield_gluon_wg),  intent(in) :: u
  real(DP),               intent(in) :: plq0
  character(len=CHARLEN) :: fname, str
  real(DP) :: plq1
  integer :: iout

  fname = fname_measure(fpath,fhead)
  iout = search_free_file_unit()

  call plaquette(u,plq1)

  if (0 == nodeid) then
    write(*,'(80("-"))')
  endif
  write(str,'("      SAVE config : ",A)')TRIM(ADJUSTL(fname))
  call print_status(str)
  if (0 == nodeid) then
    write(*,'("    PLQ(Original) : ",E24.15)')plq0
    write(*,'("    PLQ(GFixed)   : ",E24.15)')plq1
  endif

  open(iout,file=TRIM(ADJUSTL(fname)),status='unknown',form='unformatted')
  write(iout)u
  write(iout)NTX,NTY,NTZ,NTT
  write(iout)NDIMX,NDIMY,NDIMZ
  write(iout)plq1
  close(iout)

  if (0 == nodeid) then
    write(*,'(80("-"))')
  endif

  return
end subroutine
Subroutine :
fpath :character(len=CHARLEN), intent(in)
fhead :character(len=CHARLEN), intent(in)
u :type(vfield_gluon_wg), intent(in)
plq0 :real(DP), intent(in)

[Source]

subroutine save_config(fpath,fhead,u,plq0)
  use file_tools_class
  use print_status_class
  implicit none
  character(len=CHARLEN), intent(in) :: fpath,fhead
  type(vfield_gluon_wg),  intent(in) :: u
  real(DP),               intent(in) :: plq0
  character(len=CHARLEN) :: fname, str
  real(DP) :: plq1
  integer :: iout

  fname = fname_measure(fpath,fhead)
  iout = search_free_file_unit()

  call plaquette(u,plq1)

  if (0 == nodeid) then
    write(*,'(80("-"))')
  endif
  write(str,'("      SAVE config : ",A)')TRIM(ADJUSTL(fname))
  call print_status(str)
  if (0 == nodeid) then
    write(*,'("    PLQ(Original) : ",E24.15)')plq0
    write(*,'("    PLQ(GFixed)   : ",E24.15)')plq1
  endif

  open(iout,file=TRIM(ADJUSTL(fname)),status='unknown',form='unformatted')
  write(iout)u
  write(iout)NTX,NTY,NTZ,NTT
  write(iout)NDIMX,NDIMY,NDIMZ
  write(iout)plq1
  close(iout)

  if (0 == nodeid) then
    write(*,'(80("-"))')
  endif

  return
end subroutine