diff --git a/Prog/Makefile b/Prog/Makefile index 20e227ca2..dca97025e 100644 --- a/Prog/Makefile +++ b/Prog/Makefile @@ -7,12 +7,12 @@ OBJS = Hamiltonians/LRC_mod.o control_mod.o Fields_mod.o Operator_mod.o WaveFunc Predefined_Int_mod.o Predefined_Obs_mod.o Predefined_Latt_mod.o Predefined_Hop_mod.o Predefined_Trial_mod.o \ Hamiltonian_main_mod.o QDRP_decompose_mod.o udv_state_mod.o Hop_mod.o UDV_WRAP_mod.o \ wrapul_mod.o cgr1_mod.o wrapur_mod.o cgr2_2_mod.o upgrade_mod.o Set_random_mod.o \ - Global_mod.o Langevin_HMC_mod.o Wrapgr_mod.o tau_m_mod.o tau_p_mod.o \ + Global_mod.o Langevin_HMC_mod.o Wrapgr_mod.o tau_m_mod.o tau_p_mod.o QMC_runtime_var_mod.o \ main.o MODS = control.mod fields_mod.mod global_mod.mod hop_mod.mod lrc_mod.mod observables.mod \ operator_mod.mod predefined_int.mod predefined_lattices.mod predefined_obs.mod \ - predefined_hoppings.mod predefined_trial.mod qdrp_mod.mod tau_m_mod.mod tau_p_mod.mod \ + predefined_hoppings.mod predefined_trial.mod qdrp_mod.mod QMC_runtime_var_mod.mod tau_m_mod.mod tau_p_mod.mod \ udv_state_mod.mod udv_wrap_mod.mod wavefunction_mod.mod wrapgr_mod.mod hamiltonian.mod \ opt_time_dependent.mod containerelementbase_mod.mod opttypes_mod.mod dynamicmatrixarray_mod.mod langevin_hmc_mod.mod \ wrapul_mod.mod cgr1_mod.mod wrapur_mod.mod cgr2_2_mod.mod upgrade_mod.mod set_random.mod diff --git a/Prog/QMC_runtime_var_mod.F90 b/Prog/QMC_runtime_var_mod.F90 new file mode 100644 index 000000000..d23f31224 --- /dev/null +++ b/Prog/QMC_runtime_var_mod.F90 @@ -0,0 +1,608 @@ +! Copyright (C) 2016 - 2022 The ALF project +! +! The ALF project is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! The ALF project is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with ALF. If not, see http://www.gnu.org/licenses/. +! +! Under Section 7 of GPL version 3 we require you to fulfill the following additional terms: +! +! - It is our hope that this program makes a contribution to the scientific community. Being +! part of that community we feel that it is reasonable to require you to give an attribution +! back to the original authors if you have benefitted from this program. +! Guidelines for a proper citation can be found on the project's homepage +! http://alf.physik.uni-wuerzburg.de . +! +! - We require the preservation of the above copyright notice and this license in all original files. +! +! - We prohibit the misrepresentation of the origin of the original source files. To obtain +! the original source files please visit the homepage http://alf.physik.uni-wuerzburg.de . +! +! - If you make substantial changes to the program we require you to either consider contributing +! to the ALF project or to mark your material in a reasonable way as different from the original version. + +Module QMC_runtime_var + + Use runtime_error_mod + +#ifdef MPI + Use mpi +#endif + + Implicit none + + ! Make everything private by default; expose explicit APIs below + private + + Integer :: Nwrap, NSweep, NBin,Ltau, LOBS_EN, LOBS_ST + Real(Kind=Kind(0.d0)) :: CPU_MAX + ! Space for choosing sampling scheme + Logical :: Propose_S0, Tempering_calc_det + Logical :: Global_moves, Global_tau_moves + Integer :: N_Global + Integer :: Nt_sequential_start, Nt_sequential_end, mpi_per_parameter_set + Integer :: N_Global_tau + Logical :: Sequential + real (Kind=Kind(0.d0)) :: Amplitude ! Needed for update of type 3 and 4 fields. + + Character (len=64) :: ham_name + + + ! Space for reading in Langevin & HMC parameters + Logical :: Langevin, HMC + Integer :: Leapfrog_Steps, N_HMC_sweeps + Real (Kind=Kind(0.d0)) :: Delta_t_Langevin_HMC, Max_Force + + +#if defined(TEMPERING) + Integer :: N_exchange_steps, N_Tempering_frequency + NAMELIST /VAR_TEMP/ N_exchange_steps, N_Tempering_frequency, mpi_per_parameter_set, Tempering_calc_det +#endif + + NAMELIST /VAR_QMC/ Nwrap, NSweep, NBin, Ltau, LOBS_EN, LOBS_ST, CPU_MAX, & + & Propose_S0,Global_moves, N_Global, Global_tau_moves, & + & Nt_sequential_start, Nt_sequential_end, N_Global_tau, & + & sequential, Langevin, HMC, Delta_t_Langevin_HMC, & + & Max_Force, Leapfrog_steps, N_HMC_sweeps, Amplitude + + NAMELIST /VAR_HAM_NAME/ ham_name + + !===================== + ! Public API exports + !===================== + public :: set_QMC_runtime_default_var + public :: set_default_values_measuring_interval + public :: check_langevin_schemes_and_variables + public :: check_update_schemes_compatibility +#ifdef MPI + public :: broadcast_QMC_runtime_var +#endif +#ifdef TEMPERING + public :: read_and_broadcast_TEMPERING_var +#endif + public :: read_and_broadcast_QMC_var_and_ham_name + + ! Accessors (getters/setters) for runtime variables + public :: get_Nwrap, set_Nwrap + public :: get_NSweep, set_NSweep + public :: get_NBin, set_NBin + public :: get_Ltau, set_Ltau + public :: get_LOBS_EN, set_LOBS_EN + public :: get_LOBS_ST, set_LOBS_ST + public :: get_CPU_MAX, set_CPU_MAX + public :: get_Propose_S0, set_Propose_S0 + public :: get_Global_moves, set_Global_moves + public :: get_N_Global, set_N_Global + public :: get_Global_tau_moves, set_Global_tau_moves + public :: get_Nt_sequential_start, set_Nt_sequential_start + public :: get_Nt_sequential_end, set_Nt_sequential_end + public :: get_N_Global_tau, set_N_Global_tau + public :: get_sequential, set_sequential + public :: get_Langevin, set_Langevin + public :: get_HMC, set_HMC + public :: get_Leapfrog_steps, set_Leapfrog_steps + public :: get_N_HMC_sweeps, set_N_HMC_sweeps + public :: get_Max_Force, set_Max_Force + public :: get_Delta_t_Langevin_HMC, set_Delta_t_Langevin_HMC + public :: get_Amplitude, set_Amplitude + public :: get_ham_name, set_ham_name + public :: get_mpi_per_parameter_set, set_mpi_per_parameter_set + public :: get_Tempering_calc_det, set_Tempering_calc_det +#if defined(TEMPERING) + public :: get_N_exchange_steps, set_N_exchange_steps + public :: get_N_Tempering_frequency, set_N_Tempering_frequency +#endif + + + +!-------------------------------------------------------------------- +!> @author +!> ALF-project +!> +!> @brief +!> Initialization of the QMC runtime variables +!> +! +!-------------------------------------------------------------------- + contains + subroutine set_QMC_runtime_default_var() + + implicit none + + ! This is a set of variables that identical for each simulation. + Nwrap=0; NSweep=0; NBin=0; Ltau=0; LOBS_EN = 0; LOBS_ST = 0; CPU_MAX = 0.d0 + Propose_S0 = .false. ; Global_moves = .false. ; N_Global = 0 + Global_tau_moves = .false.; sequential = .true.; Langevin = .false. ; HMC =.false. + Delta_t_Langevin_HMC = 0.d0; Max_Force = 0.d0 ; Leapfrog_steps = 0; N_HMC_sweeps = 1 + Nt_sequential_start = 1 ; Nt_sequential_end = 0; N_Global_tau = 0; Amplitude = 1.d0 + + end subroutine set_QMC_runtime_default_var + + + subroutine set_default_values_measuring_interval(Thtrot, Ltrot, Projector) + + implicit none + + Integer, intent(in) :: Thtrot, Ltrot + Logical, intent(in) :: Projector + + if (Projector) then + if ( LOBS_ST == 0 ) then + LOBS_ST = Thtrot+1 + else + If (LOBS_ST < Thtrot+1 ) then + Write(error_unit,*) 'Measuring out of dedicating interval, LOBS_ST too small.' + CALL Terminate_on_error(ERROR_GENERIC,__FILE__,__LINE__) + endif + endif + if ( LOBS_EN == 0) then + LOBS_EN = Ltrot-Thtrot + else + If (LOBS_EN > Ltrot-Thtrot ) then + Write(error_unit,*) 'Measuring out of dedicating interval, LOBS_EN too big.' + CALL Terminate_on_error(ERROR_GENERIC,__FILE__,__LINE__) + endif + endif + else + if ( LOBS_ST == 0 ) then + LOBS_ST = 1 + endif + if ( LOBS_EN == 0) then + LOBS_EN = Ltrot + endif + endif + + end subroutine set_default_values_measuring_interval + + + subroutine check_langevin_schemes_and_variables() + + implicit none + + if (sequential) then + write(output_unit,*) "Langevin mode does not allow sequential updates." + write(output_unit,*) "Overriding Sequential=.True. from parameter files." + endif + if (HMC) then + write(output_unit,*) "Langevin mode does not allow HMC updates." + write(output_unit,*) "Overriding HMC=.True. from parameter files." + endif + if (Global_moves) then + write(output_unit,*) "Langevin mode does not allow global updates." + write(output_unit,*) "Overriding Global_moves=.True. from parameter files." + endif + if (Global_tau_moves) then + write(output_unit,*) "Langevin mode does not allow global tau updates." + write(output_unit,*) "Overriding Global_tau_moves=.True. from parameter files." + endif + + end subroutine check_langevin_schemes_and_variables + + ! Raise warnings for update schemes + subroutine check_update_schemes_compatibility() + + implicit none + + if ( .not. Sequential .and. Global_tau_moves) then + write(output_unit,*) "Warning: Sequential = .False. and Global_tau_moves = .True." + write(output_unit,*) "in the parameter file. Global tau updates will not occur if" + write(output_unit,*) "Sequential is set to .False. ." + endif + + if ( .not. Sequential .and. .not. HMC .and. .not. Langevin .and. .not. Global_moves) then + write(output_unit,*) "Warning: no updates will occur as Sequential, HMC, Langevin, and" + write(output_unit,*) "Global_moves are all .False. in the parameter file." + endif + + if ( Sequential .and. Nt_sequential_end < Nt_sequential_start ) then + write(output_unit,*) "Warning: Nt_sequential_end is smaller than Nt_sequential_start" + endif + + end subroutine + + !========================= + ! Accessors implementation + !========================= + + ! Integer getters/setters + integer function get_Nwrap() result(val) + val = Nwrap + end function get_Nwrap + + subroutine set_Nwrap(val) + integer, intent(in) :: val + Nwrap = val + end subroutine set_Nwrap + + integer function get_NSweep() result(val) + val = NSweep + end function get_NSweep + + subroutine set_NSweep(val) + integer, intent(in) :: val + NSweep = val + end subroutine set_NSweep + + integer function get_NBin() result(val) + val = NBin + end function get_NBin + + subroutine set_NBin(val) + integer, intent(in) :: val + NBin = val + end subroutine set_NBin + + integer function get_Ltau() result(val) + val = Ltau + end function get_Ltau + + subroutine set_Ltau(val) + integer, intent(in) :: val + Ltau = val + end subroutine set_Ltau + + integer function get_LOBS_EN() result(val) + val = LOBS_EN + end function get_LOBS_EN + + subroutine set_LOBS_EN(val) + integer, intent(in) :: val + LOBS_EN = val + end subroutine set_LOBS_EN + + integer function get_LOBS_ST() result(val) + val = LOBS_ST + end function get_LOBS_ST + + subroutine set_LOBS_ST(val) + integer, intent(in) :: val + LOBS_ST = val + end subroutine set_LOBS_ST + + integer function get_N_Global() result(val) + val = N_Global + end function get_N_Global + + subroutine set_N_Global(val) + integer, intent(in) :: val + N_Global = val + end subroutine set_N_Global + + integer function get_Nt_sequential_start() result(val) + val = Nt_sequential_start + end function get_Nt_sequential_start + + subroutine set_Nt_sequential_start(val) + integer, intent(in) :: val + Nt_sequential_start = val + end subroutine set_Nt_sequential_start + + integer function get_Nt_sequential_end() result(val) + val = Nt_sequential_end + end function get_Nt_sequential_end + + subroutine set_Nt_sequential_end(val) + integer, intent(in) :: val + Nt_sequential_end = val + end subroutine set_Nt_sequential_end + + integer function get_N_Global_tau() result(val) + val = N_Global_tau + end function get_N_Global_tau + + subroutine set_N_Global_tau(val) + integer, intent(in) :: val + N_Global_tau = val + end subroutine set_N_Global_tau + + integer function get_Leapfrog_steps() result(val) + val = Leapfrog_Steps + end function get_Leapfrog_steps + + subroutine set_Leapfrog_steps(val) + integer, intent(in) :: val + Leapfrog_Steps = val + end subroutine set_Leapfrog_steps + + integer function get_N_HMC_sweeps() result(val) + val = N_HMC_sweeps + end function get_N_HMC_sweeps + + subroutine set_N_HMC_sweeps(val) + integer, intent(in) :: val + N_HMC_sweeps = val + end subroutine set_N_HMC_sweeps + + integer function get_mpi_per_parameter_set() result(val) + val = mpi_per_parameter_set + end function get_mpi_per_parameter_set + + subroutine set_mpi_per_parameter_set(val) + integer, intent(in) :: val + mpi_per_parameter_set = val + end subroutine set_mpi_per_parameter_set + +#if defined(TEMPERING) + integer function get_N_exchange_steps() result(val) + val = N_exchange_steps + end function get_N_exchange_steps + + subroutine set_N_exchange_steps(val) + integer, intent(in) :: val + N_exchange_steps = val + end subroutine set_N_exchange_steps + + integer function get_N_Tempering_frequency() result(val) + val = N_Tempering_frequency + end function get_N_Tempering_frequency + + subroutine set_N_Tempering_frequency(val) + integer, intent(in) :: val + N_Tempering_frequency = val + end subroutine set_N_Tempering_frequency +#endif + + ! Real getters/setters + real(kind=kind(0.d0)) function get_CPU_MAX() result(val) + val = CPU_MAX + end function get_CPU_MAX + + subroutine set_CPU_MAX(val) + real(kind=kind(0.d0)), intent(in) :: val + CPU_MAX = val + end subroutine set_CPU_MAX + + real(kind=kind(0.d0)) function get_Max_Force() result(val) + val = Max_Force + end function get_Max_Force + + subroutine set_Max_Force(val) + real(kind=kind(0.d0)), intent(in) :: val + Max_Force = val + end subroutine set_Max_Force + + real(kind=kind(0.d0)) function get_Delta_t_Langevin_HMC() result(val) + val = Delta_t_Langevin_HMC + end function get_Delta_t_Langevin_HMC + + subroutine set_Delta_t_Langevin_HMC(val) + real(kind=kind(0.d0)), intent(in) :: val + Delta_t_Langevin_HMC = val + end subroutine set_Delta_t_Langevin_HMC + + real(kind=kind(0.d0)) function get_Amplitude() result(val) + val = Amplitude + end function get_Amplitude + + subroutine set_Amplitude(val) + real(kind=kind(0.d0)), intent(in) :: val + Amplitude = val + end subroutine set_Amplitude + + ! Logical getters/setters + logical function get_Propose_S0() result(val) + val = Propose_S0 + end function get_Propose_S0 + + subroutine set_Propose_S0(val) + logical, intent(in) :: val + Propose_S0 = val + end subroutine set_Propose_S0 + + logical function get_Global_moves() result(val) + val = Global_moves + end function get_Global_moves + + subroutine set_Global_moves(val) + logical, intent(in) :: val + Global_moves = val + end subroutine set_Global_moves + + logical function get_Global_tau_moves() result(val) + val = Global_tau_moves + end function get_Global_tau_moves + + subroutine set_Global_tau_moves(val) + logical, intent(in) :: val + Global_tau_moves = val + end subroutine set_Global_tau_moves + + logical function get_sequential() result(val) + val = Sequential + end function get_sequential + + subroutine set_sequential(val) + logical, intent(in) :: val + Sequential = val + end subroutine set_sequential + + logical function get_Langevin() result(val) + val = Langevin + end function get_Langevin + + subroutine set_Langevin(val) + logical, intent(in) :: val + Langevin = val + end subroutine set_Langevin + + logical function get_HMC() result(val) + val = HMC + end function get_HMC + + subroutine set_HMC(val) + logical, intent(in) :: val + HMC = val + end subroutine set_HMC + + logical function get_Tempering_calc_det() result(val) + val = Tempering_calc_det + end function get_Tempering_calc_det + + subroutine set_Tempering_calc_det(val) + logical, intent(in) :: val + Tempering_calc_det = val + end subroutine set_Tempering_calc_det + + ! Character getters/setters + character(len=64) function get_ham_name() result(val) + val = ham_name + end function get_ham_name + + subroutine set_ham_name(val) + character(len=*), intent(in) :: val + ham_name = val + end subroutine set_ham_name + + +!-------------------------------------------------------------------- +!> @author +!> ALF-project +!> +!> @brief +!> Bradcast of the QMC runtime variables +!> +! +!-------------------------------------------------------------------- +#ifdef MPI + + subroutine broadcast_QMC_runtime_var(MPI_COMM_i) + + implicit none + + Integer, intent(in) :: MPI_COMM_i + + Integer :: ierr + + CALL MPI_BCAST(Nwrap ,1 ,MPI_INTEGER ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(NSweep ,1 ,MPI_INTEGER ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(NBin ,1 ,MPI_INTEGER ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(Ltau ,1 ,MPI_INTEGER ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(LOBS_EN ,1 ,MPI_INTEGER ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(LOBS_ST ,1 ,MPI_INTEGER ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(CPU_MAX ,1 ,MPI_REAL8 ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(Propose_S0 ,1 ,MPI_LOGICAL ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(Global_moves ,1 ,MPI_LOGICAL ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(N_Global ,1 ,MPI_Integer ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(Global_tau_moves ,1 ,MPI_LOGICAL ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(Nt_sequential_start ,1 ,MPI_Integer ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(Nt_sequential_end ,1 ,MPI_Integer ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(N_Global_tau ,1 ,MPI_Integer ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(sequential ,1 ,MPI_LOGICAL ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(Langevin ,1 ,MPI_LOGICAL ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(HMC ,1 ,MPI_LOGICAL ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(Leapfrog_steps ,1 ,MPI_Integer ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(N_HMC_sweeps ,1 ,MPI_Integer ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(Max_Force ,1 ,MPI_REAL8 ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(Delta_t_Langevin_HMC ,1 ,MPI_REAL8 ,0,MPI_COMM_i,ierr) + CALL MPI_BCAST(Amplitude ,1 ,MPI_REAL8 ,0,MPI_COMM_i,ierr) + + end subroutine broadcast_QMC_runtime_var +#endif + +#ifdef TEMPERING + subroutine read_and_broadcast_TEMPERING_var() + + use iso_fortran_env, only: error_unit + use runtime_error_mod, only: Terminate_on_error, ERROR_FILE_NOT_FOUND + + implicit none + + Integer :: ierr + + mpi_per_parameter_set = 1 ! Default value + Tempering_calc_det = .true. ! Default value + OPEN(UNIT=5,FILE='parameters',STATUS='old',ACTION='read',IOSTAT=ierr) + IF (ierr /= 0) THEN + WRITE(error_unit,*) 'main: unable to open ',ierr + CALL Terminate_on_error(ERROR_FILE_NOT_FOUND,__FILE__,__LINE__) + END IF + READ(5,NML=VAR_TEMP) + CLOSE(5) + CALL MPI_BCAST(N_exchange_steps ,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) + CALL MPI_BCAST(N_Tempering_frequency ,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) + CALL MPI_BCAST(mpi_per_parameter_set ,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) + CALL MPI_BCAST(Tempering_calc_det ,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr) + + end subroutine read_and_broadcast_TEMPERING_var +#endif + + + subroutine read_and_broadcast_QMC_var_and_ham_name(Group_Comm) + + use iso_fortran_env, only: error_unit + use runtime_error_mod, only: Terminate_on_error, ERROR_FILE_NOT_FOUND + + implicit none + + Integer, intent(in) :: Group_Comm + + integer :: ierr + Character (len=64) :: file_para +#ifdef MPI + Integer :: MPI_COMM_i, irank, irank_g, Isize_g, igroup + + CALL MPI_COMM_RANK(MPI_COMM_WORLD, irank, ierr) + call MPI_Comm_rank(Group_Comm, irank_g, ierr) + call MPI_Comm_size(Group_Comm, Isize_g, ierr) + igroup = irank/isize_g + +#ifdef PARALLEL_PARAMS + MPI_COMM_i = Group_Comm + If ( irank_g == 0 ) then + write(file_para,'(A,I0,A)') "Temp_", igroup, "/parameters" +#else + MPI_COMM_i = MPI_COMM_WORLD + If ( Irank == 0 ) then + file_para = "parameters" +#endif +#else + file_para = "parameters" +#endif + + Call set_QMC_runtime_default_var() + OPEN(UNIT=5,FILE=file_para,STATUS='old',ACTION='read',IOSTAT=ierr) + IF (ierr /= 0) THEN + WRITE(error_unit,*) 'main: unable to open ', file_para, ierr + CALL Terminate_on_error(ERROR_FILE_NOT_FOUND,__FILE__,__LINE__) + END IF + READ(5,NML=VAR_QMC) + REWIND(5) + READ(5,NML=VAR_HAM_NAME) + CLOSE(5) +#ifdef MPI + Endif + call broadcast_QMC_runtime_var(MPI_COMM_i) + CALL MPI_BCAST(ham_name,64,MPI_CHARACTER,0,MPI_COMM_i,ierr) +#endif + + end subroutine read_and_broadcast_QMC_var_and_ham_name + +end Module QMC_runtime_var \ No newline at end of file diff --git a/Prog/main.F90 b/Prog/main.F90 index 8d40a10d2..a5128163c 100644 --- a/Prog/main.F90 +++ b/Prog/main.F90 @@ -114,8 +114,12 @@ Program Main +#ifdef MPI + Use mpi +#endif Use runtime_error_mod Use Operator_mod + Use QMC_runtime_var Use Lattices_v3 Use MyMats Use Hamiltonian_main @@ -135,10 +139,7 @@ Program Main use wrapul_mod use cgr1_mod use set_random - -#ifdef MPI - Use mpi -#endif + #ifdef HDF5 use hdf5 use h5lt @@ -146,56 +147,30 @@ Program Main Implicit none #include "git.h" - - COMPLEX (Kind=Kind(0.d0)), Dimension(:,:) , Allocatable :: TEST - COMPLEX (Kind=Kind(0.d0)), Dimension(:,:,:), Allocatable :: GR, GR_Tilde - CLASS(UDV_State), DIMENSION(:), ALLOCATABLE :: udvl, udvr - COMPLEX (Kind=Kind(0.d0)), Dimension(:) , Allocatable :: Phase_array + COMPLEX (Kind=Kind(0.d0)), Dimension(:,:) , Allocatable :: TEST + COMPLEX (Kind=Kind(0.d0)), Dimension(:,:,:), Allocatable :: GR, GR_Tilde + CLASS(UDV_State), DIMENSION(:), ALLOCATABLE :: udvl, udvr + COMPLEX (Kind=Kind(0.d0)), Dimension(:) , Allocatable :: Phase_array + + Integer :: NBC, NSW + Integer :: NTAU, NTAU1 + Character (len=64) :: file_seeds, file_dat, file_info + Integer :: Seed_in + Complex (Kind=Kind(0.d0)) , allocatable, dimension(:,:) :: Initial_field - Integer :: Nwrap, NSweep, NBin, NBin_eff,Ltau, NSTM, NT, NT1, NVAR, LOBS_EN, LOBS_ST, NBC, NSW - Integer :: NTAU, NTAU1 - Real(Kind=Kind(0.d0)) :: CPU_MAX - Character (len=64) :: file_seeds, file_para, file_dat, file_info, ham_name - Integer :: Seed_in - Complex (Kind=Kind(0.d0)) , allocatable, dimension(:,:) :: Initial_field - - ! Space for choosing sampling scheme - Logical :: Propose_S0, Tempering_calc_det - Logical :: Global_moves, Global_tau_moves - Integer :: N_Global - Integer :: Nt_sequential_start, Nt_sequential_end, mpi_per_parameter_set - Integer :: N_Global_tau - Logical :: Sequential - real (Kind=Kind(0.d0)) :: Amplitude ! Needed for update of type 3 and 4 fields. - #ifdef HDF5 INTEGER(HID_T) :: file_id Logical :: file_exists #endif - ! Space for reading in Langevin & HMC parameters - Logical :: Langevin, HMC - Integer :: Leapfrog_Steps, N_HMC_sweeps - Real (Kind=Kind(0.d0)) :: Delta_t_Langevin_HMC, Max_Force - -#if defined(TEMPERING) - Integer :: N_exchange_steps, N_Tempering_frequency - NAMELIST /VAR_TEMP/ N_exchange_steps, N_Tempering_frequency, mpi_per_parameter_set, Tempering_calc_det -#endif - - NAMELIST /VAR_QMC/ Nwrap, NSweep, NBin, Ltau, LOBS_EN, LOBS_ST, CPU_MAX, & - & Propose_S0,Global_moves, N_Global, Global_tau_moves, & - & Nt_sequential_start, Nt_sequential_end, N_Global_tau, & - & sequential, Langevin, HMC, Delta_t_Langevin_HMC, & - & Max_Force, Leapfrog_steps, N_HMC_sweeps, Amplitude - - NAMELIST /VAR_HAM_NAME/ ham_name - - ! General - Integer :: Ierr, I,nf, nf_eff, nst, n, n1, N_op + + !General + Integer :: NSTM, NT, NT1, NVAR + Integer :: Ierr, I,nf, nf_eff, nst, n, n1, N_op, NBin_eff + Integer :: tmp_Nt_sequential_start, tmp_Nt_sequential_end, tmp_N_Global_tau Logical :: Toggle, Toggle1 - Complex (Kind=Kind(0.d0)) :: Z_ONE = cmplx(1.d0, 0.d0, kind(0.D0)), Phase, Z, Z1 - Real (Kind=Kind(0.d0)) :: ZERO = 10D-8, X, X1 + Complex (Kind=Kind(0.d0)) :: Phase, Z, Z1 + Real (Kind=Kind(0.d0)) :: ZERO = 10D-8 Real (Kind=Kind(0.d0)) :: Mc_step_weight ! Storage for stabilization steps @@ -204,9 +179,6 @@ Program Main ! Space for storage. CLASS(UDV_State), Dimension(:,:), ALLOCATABLE :: udvst - ! For tests - Real (Kind=Kind(0.d0)) :: Weight, Weight_tot - ! For the truncation of the program: logical :: prog_truncation, run_file_exists integer (kind=kind(0.d0)) :: count_bin_start, count_bin_end @@ -217,7 +189,7 @@ Program Main Real (Kind=Kind(0.d0)) :: chunk_size_gb #ifdef MPI - Integer :: Isize, Irank, Irank_g, Isize_g, color, key, igroup, MPI_COMM_i + Integer :: Isize, Irank, Irank_g, Isize_g, color, key, igroup CALL MPI_INIT(ierr) CALL MPI_COMM_SIZE(MPI_COMM_WORLD,ISIZE,IERR) @@ -263,26 +235,14 @@ Program Main #endif #if defined(TEMPERING) && defined(MPI) - mpi_per_parameter_set = 1 ! Default value - Tempering_calc_det = .true. ! Default value - OPEN(UNIT=5,FILE='parameters',STATUS='old',ACTION='read',IOSTAT=ierr) - IF (ierr /= 0) THEN - WRITE(error_unit,*) 'main: unable to open ',ierr - CALL Terminate_on_error(ERROR_FILE_NOT_FOUND,__FILE__,__LINE__) - END IF - READ(5,NML=VAR_TEMP) - CLOSE(5) - CALL MPI_BCAST(N_exchange_steps ,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) - CALL MPI_BCAST(N_Tempering_frequency ,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) - CALL MPI_BCAST(mpi_per_parameter_set ,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) - CALL MPI_BCAST(Tempering_calc_det ,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr) - if ( mod(ISIZE,mpi_per_parameter_set) .ne. 0 ) then + call read_and_broadcast_TEMPERING_var() + if ( mod(ISIZE,get_mpi_per_parameter_set()) .ne. 0 ) then Write (error_unit,*) "mpi_per_parameter_set is not a multiple of total mpi processes" CALL Terminate_on_error(ERROR_GENERIC,__FILE__,__LINE__) endif Call Global_Tempering_setup #elif !defined(TEMPERING) && defined(MPI) - mpi_per_parameter_set = Isize + call set_mpi_per_parameter_set(Isize) #elif defined(TEMPERING) && !defined(MPI) Write(error_unit,*) 'Mpi has to be defined for tempering runs' CALL Terminate_on_error(ERROR_GENERIC,__FILE__,__LINE__) @@ -293,7 +253,7 @@ Program Main #endif #ifdef MPI - color = irank/mpi_per_parameter_set + color = irank/get_mpi_per_parameter_set() key = 0 call MPI_COMM_SPLIT(MPI_COMM_WORLD,color,key,Group_comm, ierr) call MPI_Comm_rank(Group_Comm, Irank_g, ierr) @@ -318,65 +278,11 @@ Program Main !It will then deactivate the entanglement measurements, i.e., the user does not have to care about this call Init_Entanglement_replicas(Group_Comm) + call read_and_broadcast_QMC_var_and_ham_name(Group_Comm) + NBin_eff = get_NBin() -#ifdef MPI -#ifdef PARALLEL_PARAMS - MPI_COMM_i = Group_Comm - If ( irank_g == 0 ) then - write(file_para,'(A,I0,A)') "Temp_", igroup, "/parameters" -#else - MPI_COMM_i = MPI_COMM_WORLD - If ( Irank == 0 ) then - file_para = "parameters" -#endif -#else - file_para = "parameters" -#endif - ! This is a set of variables that identical for each simulation. - Nwrap=0; NSweep=0; NBin=0; Ltau=0; LOBS_EN = 0; LOBS_ST = 0; CPU_MAX = 0.d0 - Propose_S0 = .false. ; Global_moves = .false. ; N_Global = 0 - Global_tau_moves = .false.; sequential = .true.; Langevin = .false. ; HMC =.false. - Delta_t_Langevin_HMC = 0.d0; Max_Force = 0.d0 ; Leapfrog_steps = 0; N_HMC_sweeps = 1 - Nt_sequential_start = 1 ; Nt_sequential_end = 0; N_Global_tau = 0; Amplitude = 1.d0 - OPEN(UNIT=5,FILE=file_para,STATUS='old',ACTION='read',IOSTAT=ierr) - IF (ierr /= 0) THEN - WRITE(error_unit,*) 'main: unable to open ', file_para, ierr - CALL Terminate_on_error(ERROR_FILE_NOT_FOUND,__FILE__,__LINE__) - END IF - READ(5,NML=VAR_QMC) - REWIND(5) - READ(5,NML=VAR_HAM_NAME) - CLOSE(5) - NBin_eff = NBin -#ifdef MPI - Endif - CALL MPI_BCAST(Nwrap ,1 ,MPI_INTEGER ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(NSweep ,1 ,MPI_INTEGER ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(NBin ,1 ,MPI_INTEGER ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(Ltau ,1 ,MPI_INTEGER ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(LOBS_EN ,1 ,MPI_INTEGER ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(LOBS_ST ,1 ,MPI_INTEGER ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(CPU_MAX ,1 ,MPI_REAL8 ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(Propose_S0 ,1 ,MPI_LOGICAL ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(Global_moves ,1 ,MPI_LOGICAL ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(N_Global ,1 ,MPI_Integer ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(Global_tau_moves ,1 ,MPI_LOGICAL ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(Nt_sequential_start ,1 ,MPI_Integer ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(Nt_sequential_end ,1 ,MPI_Integer ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(N_Global_tau ,1 ,MPI_Integer ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(sequential ,1 ,MPI_LOGICAL ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(Langevin ,1 ,MPI_LOGICAL ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(HMC ,1 ,MPI_LOGICAL ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(Leapfrog_steps ,1 ,MPI_Integer ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(N_HMC_sweeps ,1 ,MPI_Integer ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(Max_Force ,1 ,MPI_REAL8 ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(Delta_t_Langevin_HMC ,1 ,MPI_REAL8 ,0,MPI_COMM_i,ierr) - CALL MPI_BCAST(Amplitude ,1 ,MPI_REAL8 ,0,MPI_COMM_i,ierr) - - CALL MPI_BCAST(ham_name ,64,MPI_CHARACTER,0,MPI_COMM_i,ierr) -#endif - Call Fields_init(Amplitude) - Call Alloc_Ham(ham_name) + Call Fields_init(get_Amplitude()) + Call Alloc_Ham(get_ham_name()) leap_frog_bulk = .false. Call ham%Ham_set() ! Test if user has specified correct array size for time dependent Hamiltonians @@ -438,40 +344,23 @@ Program Main endif enddo endif - ! Default values of measuring interval. - if (Projector) then - if ( LOBS_ST == 0 ) then - LOBS_ST = Thtrot+1 - else - If (LOBS_ST < Thtrot+1 ) then - Write(error_unit,*) 'Measuring out of dedicating interval, LOBS_ST too small.' - CALL Terminate_on_error(ERROR_GENERIC,__FILE__,__LINE__) - endif - endif - if ( LOBS_EN == 0) then - LOBS_EN = Ltrot-Thtrot - else - If (LOBS_EN > Ltrot-Thtrot ) then - Write(error_unit,*) 'Measuring out of dedicating interval, LOBS_EN too big.' - CALL Terminate_on_error(ERROR_GENERIC,__FILE__,__LINE__) - endif - endif - else - if ( LOBS_ST == 0 ) then - LOBS_ST = 1 - endif - if ( LOBS_EN == 0) then - LOBS_EN = Ltrot - endif - endif - If ( .not. Global_tau_moves ) then + + Call set_default_values_measuring_interval(Thtrot, Ltrot, Projector) + + If ( .not. get_Global_tau_moves() ) then ! This corresponds to the default updating scheme - Nt_sequential_start = 1 - Nt_sequential_end = Size(OP_V,1) - N_Global_tau = 0 + call set_Nt_sequential_start(1) + call set_Nt_sequential_end(Size(OP_V,1)) + call set_N_Global_tau(0) else ! Gives the possibility to set parameters in the Hamiltonian file - Call ham%Overide_global_tau_sampling_parameters(Nt_sequential_start,Nt_sequential_end,N_Global_tau) + tmp_Nt_sequential_start = get_Nt_sequential_start() + tmp_Nt_sequential_end = get_Nt_sequential_end() + tmp_N_Global_tau = get_N_Global_tau() + Call ham%Overide_global_tau_sampling_parameters(tmp_Nt_sequential_start,tmp_Nt_sequential_end,tmp_N_Global_tau) + call set_Nt_sequential_start(tmp_Nt_sequential_start) + call set_Nt_sequential_end(tmp_Nt_sequential_end) + call set_N_Global_tau(tmp_N_Global_tau) endif call nsigma%make(N_op, Ltrot) @@ -493,8 +382,8 @@ Program Main endif Call Hop_mod_init - IF (ABS(CPU_MAX) > Zero ) NBIN = 10000000 - If (N_Global_tau > 0) then + IF (ABS(get_CPU_MAX()) > Zero ) call set_NBin(10000000) + If (get_N_Global_tau() > 0) then Call Wrapgr_alloc endif @@ -524,80 +413,52 @@ Program Main Call control_init(Group_Comm) - Call ham%Alloc_obs(Ltau) + Call ham%Alloc_obs(get_Ltau()) - If ( mod(Ltrot,nwrap) == 0 ) then - Nstm = Ltrot/nwrap + If ( mod(Ltrot,get_Nwrap()) == 0 ) then + Nstm = Ltrot/get_Nwrap() else - nstm = Ltrot/nwrap + 1 + nstm = Ltrot/get_Nwrap() + 1 endif allocate ( Stab_nt(0:Nstm) ) Stab_nt(0) = 0 do n = 1,Nstm -1 - Stab_nt(n) = nwrap*n + Stab_nt(n) = get_Nwrap()*n enddo Stab_nt(Nstm) = Ltrot ! Sequential = .true. !TODO: check if sequential is done if some fields are discrete (Warning or error termination?) - if ( Langevin .or. HMC ) then - if (Langevin) then + if ( get_Langevin() .or. get_HMC() ) then + if ( get_Langevin() ) then #if defined(MPI) - if ( Irank_g == 0 ) then + if ( Irank_g == 0 ) then #endif - if (sequential) then - write(output_unit,*) "Langevin mode does not allow sequential updates." - write(output_unit,*) "Overriding Sequential=.True. from parameter files." - endif - if (HMC) then - write(output_unit,*) "Langevin mode does not allow HMC updates." - write(output_unit,*) "Overriding HMC=.True. from parameter files." - endif - if (Global_moves) then - write(output_unit,*) "Langevin mode does not allow global updates." - write(output_unit,*) "Overriding Global_moves=.True. from parameter files." - endif - if (Global_tau_moves) then - write(output_unit,*) "Langevin mode does not allow global tau updates." - write(output_unit,*) "Overriding Global_tau_moves=.True. from parameter files." - endif + Call check_langevin_schemes_and_variables() #if defined(TEMPERING) - if ( N_exchange_steps > 0 ) then - write(output_unit,*) "Langevin mode does not allow tempering updates." - write(output_unit,*) "Overwriting N_exchange_steps to 0." - end if + if ( get_N_exchange_steps() > 0 ) then + write(output_unit,*) "Langevin mode does not allow tempering updates." + write(output_unit,*) "Overwriting N_exchange_steps to 0." + endif #endif #if defined(MPI) - endif + endif #endif - Sequential = .False. - HMC = .False. - Global_moves = .False. - Global_tau_moves = .False. + call set_sequential(.False.) + call set_HMC(.False.) + call set_Global_moves(.False.) + call set_Global_tau_moves(.False.) #if defined(TEMPERING) - N_exchange_steps = 0 + call set_N_exchange_steps(0) #endif endif - Call Langevin_HMC%make(Langevin, HMC , Delta_t_Langevin_HMC, Max_Force, Leapfrog_steps) + Call Langevin_HMC%make(get_Langevin(), get_HMC() , get_Delta_t_Langevin_HMC(), get_Max_Force(), get_Leapfrog_Steps()) else - Call Langevin_HMC%set_Update_scheme(Langevin, HMC ) + Call Langevin_HMC%set_Update_scheme(get_Langevin(), get_HMC() ) endif - if ( .not. Sequential .and. Global_tau_moves) then - write(output_unit,*) "Warning: Sequential = .False. and Global_tau_moves = .True." - write(output_unit,*) "in the parameter file. Global tau updates will not occur if" - write(output_unit,*) "Sequential is set to .False. ." - endif - - if ( .not. Sequential .and. .not. HMC .and. .not. Langevin .and. .not. Global_moves) then - write(output_unit,*) "Warning: no updates will occur as Sequential, HMC, Langevin, and" - write(output_unit,*) "Global_moves are all .False. in the parameter file." - endif - - if ( Sequential .and. Nt_sequential_end < Nt_sequential_start ) then - write(output_unit,*) "Warning: Nt_sequential_end is smaller than Nt_sequential_start" - endif + Call check_update_schemes_compatibility() #if defined(TEMPERING) write(file_info,'(A,I0,A)') "Temp_",igroup,"/info" @@ -609,41 +470,41 @@ Program Main if ( Irank_g == 0 ) then #endif Open (Unit = 50,file=file_info,status="unknown",position="append") - Write(50,*) 'Sweeps : ', Nsweep - If ( abs(CPU_MAX) < ZERO ) then - Write(50,*) 'Bins : ', NBin + Write(50,*) 'Sweeps : ', get_NSweep() + If ( abs(get_CPU_MAX()) < ZERO ) then + Write(50,*) 'Bins : ', get_NBin() Write(50,*) 'No CPU-time limitation ' else - Write(50,'(" Prog will stop after hours:",2x,F8.4)') CPU_MAX + Write(50,'(" Prog will stop after hours:",2x,F8.4)') get_CPU_MAX() endif - Write(50,*) 'Measure Int. : ', LOBS_ST, LOBS_EN - Write(50,*) 'Stabilization,Wrap : ', Nwrap + Write(50,*) 'Measure Int. : ', get_LOBS_ST(), get_LOBS_EN() + Write(50,*) 'Stabilization,Wrap : ', get_Nwrap() Write(50,*) 'Nstm : ', NSTM - Write(50,*) 'Ltau : ', Ltau + Write(50,*) 'Ltau : ', get_Ltau() Write(50,*) '# of interacting Ops per time slice : ', Size(OP_V,1) - If ( Propose_S0 ) & + If ( get_Propose_S0() ) & & Write(50,*) 'Propose Ising moves according to bare Ising action' - If ( Global_moves ) Then + If ( get_Global_moves() ) Then Write(50,*) 'Global moves are enabled ' - Write(50,*) '# of global moves / sweep :', N_Global + Write(50,*) '# of global moves / sweep :', get_N_Global() Endif - if ( sequential ) then - If ( Global_tau_moves ) Then - Write(50,*) 'Nt_sequential_start: ', Nt_sequential_start - Write(50,*) 'Nt_sequential_end : ', Nt_sequential_end - Write(50,*) 'N_Global_tau : ', N_Global_tau + if ( get_sequential() ) then + If ( get_Global_tau_moves() ) Then + Write(50,*) 'Nt_sequential_start: ', get_Nt_sequential_start() + Write(50,*) 'Nt_sequential_end : ', get_Nt_sequential_end() + Write(50,*) 'N_Global_tau : ', get_N_Global_tau() else Write(50,*) 'Default sequential updating ' endif endif - if ( Langevin ) then - Write(50,*) 'Langevin del_t: ', Delta_t_Langevin_HMC - Write(50,*) 'Max Force : ', Max_Force + if ( get_Langevin() ) then + Write(50,*) 'Langevin del_t: ', get_Delta_t_Langevin_HMC() + Write(50,*) 'Max Force : ', get_Max_Force() endif - if ( HMC ) then - Write(50,*) 'HMC del_t : ', Delta_t_Langevin_HMC - Write(50,*) 'Leapfrog_Steps: ', Leapfrog_Steps - Write(50,*) 'HMC_Sweeps: ', N_HMC_sweeps + if ( get_HMC() ) then + Write(50,*) 'HMC del_t : ', get_Delta_t_Langevin_HMC() + Write(50,*) 'Leapfrog_Steps: ', get_Leapfrog_steps() + Write(50,*) 'HMC_Sweeps: ', get_N_HMC_sweeps() endif !Write out info for amplitude and flip_protocol @@ -652,7 +513,7 @@ Program Main if (nsigma%t(n) == 3 .or. nsigma%t(n) == 4) Toggle = .true. Enddo if ( Toggle ) then - Write(50,*) 'Amplitude for t=3,4 vertices is set to: ', Amplitude + Write(50,*) 'Amplitude for t=3,4 vertices is set to: ', get_Amplitude() endif Toggle = .false. Do n = 1,N_op @@ -694,9 +555,9 @@ Program Main Write(50,*) 'QRREF is defined ' #endif #if defined(TEMPERING) && !defined(PARALLEL_PARAMS) - Write(50,*) '# of exchange steps ',N_exchange_steps - Write(50,*) 'Tempering frequency ',N_Tempering_frequency - Write(50,*) 'Tempering Calc_det ',Tempering_calc_det + Write(50,*) '# of exchange steps ', get_N_exchange_steps() + Write(50,*) 'Tempering frequency ', get_N_Tempering_frequency() + Write(50,*) 'Tempering Calc_det ', get_Tempering_calc_det() #endif close(50) #if defined(MPI) @@ -757,79 +618,79 @@ Program Main Call Control_init(Group_Comm) - DO NBC = 1, NBIN + DO NBC = 1, get_NBin() ! Here, you have the green functions on time slice 1. ! Set bin observables to zero. call system_clock(count_bin_start) - Call ham%Init_obs(Ltau) + Call ham%Init_obs(get_Ltau()) #if defined(TEMPERING) Call Global_Tempering_init_obs #endif - DO NSW = 1, NSWEEP + DO NSW = 1, get_NSweep() #if defined(TEMPERING) && !defined(PARALLEL_PARAMS) - IF (MOD(NSW,N_Tempering_frequency) == 0) then - !Write(6,*) "Irank, Call tempering", Irank, NSW, N_exchange_steps - CALL Exchange_Step(Phase,GR,udvr, udvl,Stab_nt, udvst, N_exchange_steps, Tempering_calc_det) + IF (MOD(NSW,get_N_Tempering_frequency()) == 0) then + !Write(6,*) "Irank, Call tempering", Irank, NSW, get_N_exchange_steps() + CALL Exchange_Step(Phase,GR,udvr, udvl,Stab_nt, udvst, get_N_exchange_steps(), get_Tempering_calc_det()) endif #endif ! Global updates - If (Global_moves) Call Global_Updates(Phase, GR, udvr, udvl, Stab_nt, udvst,N_Global) + If ( get_Global_moves() ) Call Global_Updates(Phase, GR, udvr, udvl, Stab_nt, udvst, get_N_Global() ) If ( str_to_upper(Langevin_HMC%get_Update_scheme()) == "LANGEVIN" ) then ! Carry out a Langevin update and calculate equal time observables. Call Langevin_HMC%update(Phase, GR, GR_Tilde, Test, udvr, udvl, Stab_nt, udvst, & - & LOBS_ST, LOBS_EN, LTAU) + & get_LOBS_ST(), get_LOBS_EN(), get_Ltau()) - IF ( LTAU == 1 ) then + IF ( get_Ltau() == 1 ) then If (Projector) then NST = 0 - Call Tau_p ( udvl, udvr, udvst, GR, PHASE, NSTM, STAB_NT, NST, LOBS_ST, LOBS_EN) + Call Tau_p ( udvl, udvr, udvst, GR, PHASE, NSTM, STAB_NT, NST, get_LOBS_ST(), get_LOBS_EN()) call Langevin_HMC%set_L_Forces(.true.) else - Call Tau_m( udvst, GR, PHASE, NSTM, NWRAP, STAB_NT, LOBS_ST, LOBS_EN ) + Call Tau_m( udvst, GR, PHASE, NSTM, get_Nwrap(), STAB_NT, get_LOBS_ST(), get_LOBS_EN() ) call Langevin_HMC%set_L_Forces(.true.) endif endif endif If ( str_to_upper(Langevin_HMC%get_Update_scheme()) == "HMC" ) then - if (Sequential) call Langevin_HMC%set_L_Forces(.False.) - Do n=1, N_HMC_sweeps + if ( get_sequential() ) call Langevin_HMC%set_L_Forces(.False.) + Do n=1, get_N_HMC_sweeps() ! Carry out a Langevin update and calculate equal time observables. Call Langevin_HMC%update(Phase, GR, GR_Tilde, Test, udvr, udvl, Stab_nt, udvst, & - & LOBS_ST, LOBS_EN, LTAU) - if (n /= N_HMC_sweeps) then + & get_LOBS_ST(), get_LOBS_EN(), get_Ltau()) + if (n /= get_N_HMC_sweeps()) then Call Langevin_HMC%calc_Forces(Phase, GR, GR_Tilde, Test, udvr, udvl, Stab_nt, udvst,& - & LOBS_ST, LOBS_EN, .True. ) + & get_LOBS_ST(), get_LOBS_EN(), .True. ) Call Langevin_HMC_Reset_storage(Phase, GR, udvr, udvl, Stab_nt, udvst) call Langevin_HMC%set_L_Forces(.true.) endif enddo !Do time-displaced measurements if needed, else set Calc_Obser_eq=.True. for the very first leapfrog ONLY - If ( .not. sequential) then - IF ( LTAU == 1 ) then + If ( .not. get_sequential() ) then + IF ( get_Ltau() == 1 ) then If (Projector) then NST = 0 - Call Tau_p ( udvl, udvr, udvst, GR, PHASE, NSTM, STAB_NT, NST, LOBS_ST, LOBS_EN) + Call Tau_p ( udvl, udvr, udvst, GR, PHASE, NSTM, STAB_NT, NST, get_LOBS_ST(), get_LOBS_EN()) else - Call Tau_m( udvst, GR, PHASE, NSTM, NWRAP, STAB_NT, LOBS_ST, LOBS_EN ) + Call Tau_m( udvst, GR, PHASE, NSTM, get_Nwrap(), STAB_NT, get_LOBS_ST(), get_LOBS_EN() ) endif else Call Langevin_HMC%calc_Forces(Phase, GR, GR_Tilde, Test, udvr, udvl, Stab_nt, udvst,& - & LOBS_ST, LOBS_EN, .True. ) + & get_LOBS_ST(), get_LOBS_EN(), .True. ) Call Langevin_HMC_Reset_storage(Phase, GR, udvr, udvl, Stab_nt, udvst) endif call Langevin_HMC%set_L_Forces(.true.) endif endif - If (Sequential) then + If ( get_sequential() ) then ! Propagation from 1 to Ltrot ! Set the right storage to 1 do nf_eff = 1,N_FL_eff @@ -844,7 +705,7 @@ Program Main NST = 1 DO NTAU = 0, LTROT-1 NTAU1 = NTAU + 1 - CALL WRAPGRUP(GR,NTAU,PHASE,Propose_S0, Nt_sequential_start, Nt_sequential_end, N_Global_tau) + CALL WRAPGRUP(GR,NTAU,PHASE,get_Propose_S0(), get_Nt_sequential_start(), get_Nt_sequential_end(), get_N_Global_tau()) If (NTAU1 == Stab_nt(NST) ) then NT1 = Stab_nt(NST-1) @@ -872,7 +733,7 @@ Program Main NST = NST + 1 ENDIF - IF (NTAU1.GE. LOBS_ST .AND. NTAU1.LE. LOBS_EN ) THEN + IF (NTAU1.GE. get_LOBS_ST() .AND. NTAU1.LE. get_LOBS_EN() ) THEN !Call Global_tau_mod_Test(Gr,ntau1) !Stop !write(*,*) "GR before obser sum: ",sum(GR(:,:,1)) @@ -903,8 +764,8 @@ Program Main NST = NSTM-1 DO NTAU = LTROT,1,-1 NTAU1 = NTAU - 1 - CALL WRAPGRDO(GR,NTAU, PHASE,Propose_S0,Nt_sequential_start, Nt_sequential_end, N_Global_tau) - IF (NTAU1.GE. LOBS_ST .AND. NTAU1.LE. LOBS_EN ) THEN + CALL WRAPGRDO(GR,NTAU, PHASE,get_Propose_S0(),get_Nt_sequential_start(), get_Nt_sequential_end(), get_N_Global_tau()) + IF (NTAU1.GE. get_LOBS_ST() .AND. NTAU1.LE. get_LOBS_EN() ) THEN !write(*,*) "GR before obser sum: ",sum(GR(:,:,1)) !write(*,*) "Phase before obser : ",phase Mc_step_weight = 1.d0 @@ -944,8 +805,8 @@ Program Main Z=Z**N_SUN Call Control_PrecisionP(Z,Phase) Phase = Z - IF( LTAU == 1 .and. Projector .and. Stab_nt(NST)<=THTROT+1 .and. THTROT+1 Zero ) then - Call make_truncation(prog_truncation,CPU_MAX,count_bin_start,count_bin_end,group_comm) + if ( abs(get_CPU_MAX()) > Zero ) then + Call make_truncation(prog_truncation,get_CPU_MAX(),count_bin_start,count_bin_end,group_comm) endif If (prog_truncation) then Nbin_eff = nbc @@ -1030,7 +891,7 @@ Program Main DEALLOCATE(udvl, udvr, udvst) DEALLOCATE(GR, TEST, Stab_nt,GR_Tilde) if (Projector) DEALLOCATE(WF_R, WF_L) - If (N_Global_tau > 0) then + If (get_N_Global_tau() > 0) then Call Wrapgr_dealloc endif do nf = 1, N_FL @@ -1053,7 +914,7 @@ Program Main #if defined(MPI) If (Irank_g == 0 ) then #endif - if ( abs(CPU_MAX) > Zero ) then + if ( abs(get_CPU_MAX()) > Zero ) then #if defined(TEMPERING) write(file_info,'(A,I0,A)') "Temp_",igroup,"/info" #else