Class | fix_gauge_class |
In: |
FixGauge_v1.0/fix_gauge_class.F90
FixGauge/fix_gauge_class.F90 |
Derived Type : | |||
job_id : | character(len=CHARLEN)
| ||
input_fname : | character(len=CHARLEN)
| ||
cwd : | character(len=CHARLEN)
| ||
fpath_in : | character(len=CHARLEN)
| ||
fhead_in : | character(len=CHARLEN)
| ||
fpath_out : | character(len=CHARLEN)
| ||
fhead_out : | character(len=CHARLEN)
| ||
reunit_log_fname = "gfix_reunit." : | character(len=CHARLEN)
| ||
eps1 : | real(DP)
| ||
eps2 : | real(DP)
| ||
omega : | real(DP)
| ||
omega_new : | real(DP)
| ||
idim_max : | integer
| ||
iter_max : | integer
| ||
isweep_CM : | integer
| ||
iter_OR_begin : | integer
| ||
iter_conv_check_begin : | integer
| ||
iter_print_skip : | integer
| ||
iter_reunit_skip : | integer
| ||
itry_OR_max : | integer
| ||
iter_inc_OR_begin : | integer
| ||
itry_read : | integer
| ||
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
Derived Type : | |||
job_id : | character(len=CHARLEN)
| ||
input_fname : | character(len=CHARLEN)
| ||
cwd : | character(len=CHARLEN)
| ||
fpath_in : | character(len=CHARLEN)
| ||
fhead_in : | character(len=CHARLEN)
| ||
fpath_out : | character(len=CHARLEN)
| ||
fhead_out : | character(len=CHARLEN)
| ||
reunit_log_fname = "gfix_reunit." : | character(len=CHARLEN)
| ||
eps1 : | real(DP)
| ||
eps2 : | real(DP)
| ||
omega : | real(DP)
| ||
omega_new : | real(DP)
| ||
idim_max : | integer
| ||
iter_max : | integer
| ||
isweep_CM : | integer
| ||
iter_OR_begin : | integer
| ||
iter_conv_check_begin : | integer
| ||
iter_print_skip : | integer
| ||
iter_reunit_skip : | integer
| ||
itry_OR_max : | integer
| ||
iter_inc_OR_begin : | integer
| ||
itry_read : | integer
| ||
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) |
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) |
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) |
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) |
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
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
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
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
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
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
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) |
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) |
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
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
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) |
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) |
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