Class | measure_class |
In: |
MeasureClass/OLDS/measure_class.F90
MeasureClass/BK/measure_main.F90 |
Subroutine : | |
path : | character(len=*), intent(in) |
head : | character(len=*), intent(in) |
status : | type(hmc_status), intent(inout) |
u : | type(vfield_gluon_wg), intent(inout) |
Save configuration for measurment
This is called in run mehtod and is private method.
subroutine load_config(path,head,status,u) ! ! Save configuration for measurment ! ! This is called in run mehtod and is private method. ! use file_tools_class use hmc_identity use print_status_class use logfile_class implicit none character(len=*), intent(in) :: path,head type(hmc_status), intent(inout) :: status type(vfield_gluon_wg), intent(inout) :: u character(CHARLEN) :: fname character(CHARLEN) :: comment,cdate,ctime,czone character(CHARLEN) :: cdtnmd character(CHARLEN) :: char type(logfile) :: reunit_log character(CHARLEN) :: reunit_log_fname real(DP) :: plq0,plq1,diff_plq,tol integer :: NTT0,NTZ0,NTY0,NTX0 integer :: NDIMZ0,NDIMY0,NDIMX0 integer :: iout,iflg,itraj,rand_seed logical :: flag flag = is_save_config(status) if (.not. flag) return itraj = get_trajectory_number(status) if (nodeid == 0) then write(*,'(80("-"))') write(*,'(" load config @ traj=",I6)')itraj endif fname=fname_save(itraj,path,head) write(char,'(" load conf :",a)')TRIM(fname) call print_status(char) iout = search_free_file_unit() open(iout,file=TRIM(ADJUSTL(fname)),status='old',form='unformatted') read(iout) u read(iout) NTX0,NTY0,NTZ0,NTT0 read(iout) NDIMX0,NDIMY0,NDIMZ0 read(iout) plq0 close(iout) write(char,'(I6.6)')itraj reunit_log_fname="measure_reunit_log."//TRIM(ADJUSTL(char)) call new(reunit_log,reunit_log_fname) call reunitarize(u,reunit_log) call delete(reunit_log) call copy_boundary(u) call plaquette(u,plq1) diff_plq = abs((plq1-plq0)/plq0) tol = 100*EPSILON(plq1) !!! 100*2.2d-16 = 2.2d-14 if (diff_plq > tol) then if (nodeid == 0) then write(*,'(" Cont. Gauge PLQ chack sum is inconsistent!")') write(*,'(" Old :",E24.16)')plq0 write(*,'(" New :",E24.16)')plq1 write(*,'(" Diff :",E24.16," > TOL :",E24.16)')diff_plq,tol endif call error_stop("") endif if (nodeid == 0) then write(*,'(" PLQ(OLD) :",F24.16)')plq0 write(*,'(" PLQ(NEW) :",F24.16)')plq1 write(*,'(80("-"))') endif return end subroutine
Subroutine : | |
path : | character(len=*), intent(in) |
head : | character(len=*), intent(in) |
status : | type(hmc_status), intent(inout) |
u : | type(vfield_gluon_wg), intent(inout) |
Save configuration for measurment
This is called in run mehtod and is private method.
subroutine load_config(path,head,status,u) ! ! Save configuration for measurment ! ! This is called in run mehtod and is private method. ! use file_tools_class use hmc_identity use print_status_class implicit none character(len=*), intent(in) :: path,head type(hmc_status), intent(inout) :: status type(vfield_gluon_wg), intent(inout) :: u character(CHARLEN) :: fname character(CHARLEN) :: comment,cdate,ctime,czone character(CHARLEN) :: cdtnmd character(CHARLEN) :: char real(DP) :: plq0,plq1 integer :: NTT0,NTZ0,NTY0,NTX0 integer :: NDIMZ0,NDIMY0,NDIMX0 integer :: iout,iflg,itraj,rand_seed logical :: flag flag = is_save_config(status) if (.not. flag) return itraj = get_trajectory_number(status) fname=fname_save(itraj,path,head) write(char,'(" load conf :",a)')TRIM(fname) call print_status(char) iout = search_free_file_unit() open(iout,file=TRIM(ADJUSTL(fname)),status='old',form='unformatted') read(iout) u read(iout) NTX0,NTY0,NTZ0,NTT0 read(iout) NDIMX0,NDIMY0,NDIMZ0 read(iout) plq0 close(iout) call copy_boundary(u) call plaquette(u,plq1) if (abs(plq1-plq0) > 10*EPSILON(plq1)) then if (nodeid == 0) then write(*,'(" Cont. Gauge PLQ chack sum is inconsistent!")') write(*,'(" Old :",E24.16)')plq0 write(*,'(" New :",E24.16)')plq1 write(*,'(" Diff :",E24.16)')(plq1-plq0)/plq0 endif call error_stop("") endif if (nodeid == 0) then write(*,'(80("-"))') write(*,'(" PLQ(OLD) :",F24.16)')plq0 write(*,'(" PLQ(NEW) :",F24.16)')plq1 write(*,*) endif return end subroutine