From 6c31326869c84d4ab5dd89eadb85ff3bb051d487 Mon Sep 17 00:00:00 2001 From: Lidia Date: Mon, 4 Aug 2025 15:24:47 +0200 Subject: [PATCH 01/17] runtime variables on separatedfile --- Prog/MC_runtime_var_mod.F90 | 93 +++++++++++++++++++++++++++++++++++++ Prog/Makefile | 4 +- Prog/main.F90 | 68 ++++----------------------- 3 files changed, 103 insertions(+), 62 deletions(-) create mode 100644 Prog/MC_runtime_var_mod.F90 diff --git a/Prog/MC_runtime_var_mod.F90 b/Prog/MC_runtime_var_mod.F90 new file mode 100644 index 000000000..e7861c5b0 --- /dev/null +++ b/Prog/MC_runtime_var_mod.F90 @@ -0,0 +1,93 @@ +! 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 MC_runtime_var + + Use UDV_State_mod + + Implicit none + + 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. + +! 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 + + + 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 + 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 + Real (Kind=Kind(0.d0)) :: Mc_step_weight + + ! Storage for stabilization steps + Integer, dimension(:), allocatable :: Stab_nt + + ! 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 + + ! For MPI shared memory + character(64), parameter :: name="ALF_SHM_CHUNK_SIZE_GB" + character(64) :: chunk_size_str + Real (Kind=Kind(0.d0)) :: chunk_size_gb + +end Module MC_runtime_var \ No newline at end of file diff --git a/Prog/Makefile b/Prog/Makefile index 20e227ca2..0cf1df124 100644 --- a/Prog/Makefile +++ b/Prog/Makefile @@ -7,11 +7,11 @@ 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 MC_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 \ + MC_runtime_var_mod.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 \ 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 \ diff --git a/Prog/main.F90 b/Prog/main.F90 index 8d40a10d2..4b5dc736d 100644 --- a/Prog/main.F90 +++ b/Prog/main.F90 @@ -113,7 +113,8 @@ Program Main - + + Use MC_runtime_var Use runtime_error_mod Use Operator_mod Use Lattices_v3 @@ -124,7 +125,6 @@ Program Main Use Tau_p_mod Use Hop_mod Use Global_mod - Use UDV_State_mod Use Wrapgr_mod Use Fields_mod Use WaveFunction_mod @@ -139,6 +139,7 @@ Program Main #ifdef MPI Use mpi #endif + #ifdef HDF5 use hdf5 use h5lt @@ -146,76 +147,23 @@ 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 :: 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 - 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 - Real (Kind=Kind(0.d0)) :: Mc_step_weight - - ! Storage for stabilization steps - Integer, dimension(:), allocatable :: Stab_nt - - ! 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 - - ! For MPI shared memory - character(64), parameter :: name="ALF_SHM_CHUNK_SIZE_GB" - character(64) :: chunk_size_str - Real (Kind=Kind(0.d0)) :: chunk_size_gb - #ifdef MPI Integer :: Isize, Irank, Irank_g, Isize_g, color, key, igroup, MPI_COMM_i From 9941d91798221110e25670b59c91891df679a6c2 Mon Sep 17 00:00:00 2001 From: Lidia Date: Mon, 4 Aug 2025 15:33:18 +0200 Subject: [PATCH 02/17] rename MC_var -> QMC_var --- ...Hamiltonian_Hubbard_Plain_Vanilla_smod.F90 | 60 +++++++++++-------- Prog/Makefile | 4 +- ...me_var_mod.F90 => QMC_runtime_var_mod.F90} | 4 +- Prog/main.F90 | 2 +- 4 files changed, 40 insertions(+), 30 deletions(-) rename Prog/{MC_runtime_var_mod.F90 => QMC_runtime_var_mod.F90} (98%) diff --git a/Prog/Hamiltonians/Hamiltonian_Hubbard_Plain_Vanilla_smod.F90 b/Prog/Hamiltonians/Hamiltonian_Hubbard_Plain_Vanilla_smod.F90 index 0ce6b005d..c25990cb8 100644 --- a/Prog/Hamiltonians/Hamiltonian_Hubbard_Plain_Vanilla_smod.F90 +++ b/Prog/Hamiltonians/Hamiltonian_Hubbard_Plain_Vanilla_smod.F90 @@ -115,7 +115,6 @@ !> !-------------------------------------------------------------------- - submodule (Hamiltonian_main) ham_Hubbard_Plain_Vanilla_smod Use Operator_mod @@ -130,6 +129,7 @@ Use Predefined_Hoppings Use LRC_Mod use runtime_error_mod + Implicit none @@ -147,6 +147,7 @@ #ifdef HDF5 procedure, nopass :: write_parameters_hdf5 #endif + end type ham_Hubbard_Plain_Vanilla !#PARAMETERS START# VAR_lattice @@ -158,12 +159,14 @@ !#PARAMETERS START# VAR_Hubbard_Plain_Vanilla real(Kind=Kind(0.d0)) :: ham_T = 1.d0 ! Hopping parameter +!!!!!!! Modifications for Exercise 1a + real (Kind=Kind(0.d0)) :: Ham_Ty = 1.d0 ! Hopping parameter in y +!!!!!!! real(Kind=Kind(0.d0)) :: Ham_chem = 0.d0 ! Chemical potential real(Kind=Kind(0.d0)) :: Ham_U = 4.d0 ! Hubbard interaction real(Kind=Kind(0.d0)) :: Dtau = 0.1d0 ! Thereby Ltrot=Beta/dtau real(Kind=Kind(0.d0)) :: Beta = 5.d0 ! Inverse temperature !logical :: Projector= .false. ! Whether the projective algorithm is used - logical :: Adiabatic= .false. ! If true, and projector true then adiabatic switching on of U. real(Kind=Kind(0.d0)) :: Theta = 10.d0 ! Projection parameter !logical :: Symm = .true. ! Whether symmetrization takes place Integer :: N_part = -1 ! Number of particles in trial wave function. If N_part < 0 -> N_part = L1*L2/2 @@ -192,13 +195,23 @@ end Subroutine Ham_Alloc_Hubbard_Plain_Vanilla !-------------------------------------------------------------------- Subroutine Ham_Set + Use QMC_runtime_var + + + #if defined (MPI) || defined(TEMPERING) Use mpi + #endif Implicit none integer :: ierr, nf, unit_info Character (len=64) :: file_info + + if(Sequential) then + Write(error_unit,*) 'Sequential has to be defined for Hamiltonian_Hubbard_Plain_Vanilla (this is not true, just running a test to see if the QMC variables are accessible)' + CALL Terminate_on_error(ERROR_GENERIC,__FILE__,__LINE__) + endif @@ -221,11 +234,6 @@ Subroutine Ham_Set Call Terminate_on_error(ERROR_HAMILTONIAN,__FILE__,__LINE__) endif - if ( (.not. projector) .and. adiabatic) then - write(output_unit,*) "Adiabatic mode is only implemented for projective code." - write(output_unit,*) "Overriding Adiabatic=.True. from parameter files." - endif - if (N_part < 0) N_part = L1*L2/2 Ltrot = nint(beta/dtau) Thtrot = 0 @@ -267,13 +275,15 @@ Subroutine Ham_Set Write(unit_info,*) 'Theta : ', Theta Write(unit_info,*) 'Tau_max : ', beta Write(unit_info,*) '# of particles: ', N_part - Write(unit_info,*) 'Adiabatic switching on of U: ', Adiabatic else Write(unit_info,*) 'Finite temperture version' Write(unit_info,*) 'Beta : ', Beta endif Write(unit_info,*) 'dtau,Ltrot_eff: ', dtau,Ltrot Write(unit_info,*) 't : ', Ham_T +!!!!!!! Modifications for Exercise 1a + Write(unit_info,*) 'ty : ', Ham_Ty +!!!!!!! Write(unit_info,*) 'Ham_U : ', Ham_U Write(unit_info,*) 'Ham_chem : ', Ham_chem If ( Ham_U >=0.d0 .and. Ham_chem == 0.d0 ) then @@ -359,8 +369,12 @@ Subroutine Ham_Hop Op_T(1,nf)%O(Ix, I ) = cmplx(-Ham_T, 0.d0, kind(0.D0)) If ( L2 > 1 ) then Iy = Latt%nnlist(I,0,1) - Op_T(1,nf)%O(I, Iy) = cmplx(-Ham_T, 0.d0, kind(0.D0)) - Op_T(1,nf)%O(Iy, I ) = cmplx(-Ham_T, 0.d0, kind(0.D0)) +!!!!!!! Modifications for Exercise 1a + !Op_T(1,nf)%O(I, Iy) = cmplx(-Ham_T, 0.d0, kind(0.D0)) + !Op_T(1,nf)%O(Iy, I ) = cmplx(-Ham_T, 0.d0, kind(0.D0)) + Op_T(1,nf)%O(I, Iy) = cmplx(-Ham_Ty, 0.d0, kind(0.D0)) + Op_T(1,nf)%O(Iy, I ) = cmplx(-Ham_Ty, 0.d0, kind(0.D0)) +!!!!!!! endif Op_T(1,nf)%O(I, I ) = cmplx(-Ham_chem, 0.d0, kind(0.D0)) Op_T(1,nf)%P(i) = i @@ -404,8 +418,12 @@ Subroutine Ham_Trial() H0(Ix, I ) = -Ham_T*(1.d0 + Delta*cos(Pi*real(Latt%list(I,1) + Latt%list(I,2),Kind(0.d0)))) If (L2 > 1 ) Then Iy = Latt%nnlist(I,0,1) - H0(I, Iy) = -Ham_T *(1.d0 - Delta) - H0(Iy, I ) = -Ham_T *(1.d0 - Delta) +!!!!!!! Modifications for Exercise 1a + !H0(I, Iy) = -Ham_T *(1.d0 - Delta) + !H0(Iy, I ) = -Ham_T *(1.d0 - Delta) + H0(I, Iy) = -Ham_Ty *(1.d0 - Delta) + H0(Iy, I ) = -Ham_Ty *(1.d0 - Delta) +!!!!!!! Endif Enddo Call Diag(H0,U0,E0) @@ -439,7 +457,7 @@ Subroutine Ham_V Use Predefined_Int Implicit none - Integer :: nf, I, nt + Integer :: nf, I Real (Kind=Kind(0.d0)) :: X @@ -457,22 +475,14 @@ Subroutine Ham_V Do i = 1,Ndim Op_V(i,nf)%P(1) = I Op_V(i,nf)%O(1,1) = cmplx(1.d0, 0.d0, kind(0.D0)) - If (Adiabatic) then - Allocate(OP_V(i,nf)%g_t(Ltrot)) - Op_V(i,nf)%g_t = X*SQRT(CMPLX(DTAU*ham_U/2.d0, 0.D0, kind(0.D0))) - do nt = 1, Thtrot - Op_V(i,nf)%g_t(nt) = X*SQRT(CMPLX(DTAU*dble(nt)/dble(thtrot)*ham_U/2.d0, 0.D0, kind(0.D0))) - Op_V(i,nf)%g_t(Ltrot-(nt-1)) = X*SQRT(CMPLX(DTAU*dble(nt)/dble(thtrot)*ham_U/2.d0, 0.D0, kind(0.D0))) - enddo - else - Op_V(i,nf)%g = X*SQRT(CMPLX(DTAU*ham_U/2.d0, 0.D0, kind(0.D0))) - endif + Op_V(i,nf)%g = X*SQRT(CMPLX(DTAU*ham_U/2.d0, 0.D0, kind(0.D0))) Op_V(i,nf)%alpha = cmplx(-0.5d0, 0.d0, kind(0.D0)) Op_V(i,nf)%type = 2 Call Op_set( Op_V(i,nf) ) Enddo Enddo + end Subroutine Ham_V @@ -491,7 +501,7 @@ Subroutine Alloc_obs(Ltau) Integer, Intent(In) :: Ltau Integer :: i, N, Nt Character (len=64) :: Filename - Character (len=:), allocatable :: Channel + Character (len=2) :: Channel ! Scalar observables @@ -863,4 +873,4 @@ Subroutine GRT_reconstruction(GT0, G0T) endif end Subroutine GRT_reconstruction - end submodule ham_Hubbard_Plain_Vanilla_smod + end submodule ham_Hubbard_Plain_Vanilla_smod \ No newline at end of file diff --git a/Prog/Makefile b/Prog/Makefile index 0cf1df124..9568a9db3 100644 --- a/Prog/Makefile +++ b/Prog/Makefile @@ -7,11 +7,11 @@ 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 MC_runtime_var_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 \ - MC_runtime_var_mod.mod operator_mod.mod predefined_int.mod predefined_lattices.mod predefined_obs.mod \ + QMC_runtime_var_mod.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 \ 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 \ diff --git a/Prog/MC_runtime_var_mod.F90 b/Prog/QMC_runtime_var_mod.F90 similarity index 98% rename from Prog/MC_runtime_var_mod.F90 rename to Prog/QMC_runtime_var_mod.F90 index e7861c5b0..66e4504f1 100644 --- a/Prog/MC_runtime_var_mod.F90 +++ b/Prog/QMC_runtime_var_mod.F90 @@ -29,7 +29,7 @@ ! - 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 MC_runtime_var +Module QMC_runtime_var Use UDV_State_mod @@ -90,4 +90,4 @@ Module MC_runtime_var character(64) :: chunk_size_str Real (Kind=Kind(0.d0)) :: chunk_size_gb -end Module MC_runtime_var \ No newline at end of file +end Module QMC_runtime_var \ No newline at end of file diff --git a/Prog/main.F90 b/Prog/main.F90 index 4b5dc736d..9d064a15d 100644 --- a/Prog/main.F90 +++ b/Prog/main.F90 @@ -114,7 +114,7 @@ Program Main - Use MC_runtime_var + Use QMC_runtime_var Use runtime_error_mod Use Operator_mod Use Lattices_v3 From dae2aca4bf9d89a2d1ec645b5297ae86780f72e4 Mon Sep 17 00:00:00 2001 From: Lidia Stocker Date: Mon, 4 Aug 2025 13:59:59 +0000 Subject: [PATCH 03/17] Revert "rename MC_var -> QMC_var" This reverts commit 9941d91798221110e25670b59c91891df679a6c2 --- ...Hamiltonian_Hubbard_Plain_Vanilla_smod.F90 | 60 ++++++++----------- ...ime_var_mod.F90 => MC_runtime_var_mod.F90} | 4 +- Prog/Makefile | 4 +- Prog/main.F90 | 2 +- 4 files changed, 30 insertions(+), 40 deletions(-) rename Prog/{QMC_runtime_var_mod.F90 => MC_runtime_var_mod.F90} (98%) diff --git a/Prog/Hamiltonians/Hamiltonian_Hubbard_Plain_Vanilla_smod.F90 b/Prog/Hamiltonians/Hamiltonian_Hubbard_Plain_Vanilla_smod.F90 index c25990cb8..0ce6b005d 100644 --- a/Prog/Hamiltonians/Hamiltonian_Hubbard_Plain_Vanilla_smod.F90 +++ b/Prog/Hamiltonians/Hamiltonian_Hubbard_Plain_Vanilla_smod.F90 @@ -115,6 +115,7 @@ !> !-------------------------------------------------------------------- + submodule (Hamiltonian_main) ham_Hubbard_Plain_Vanilla_smod Use Operator_mod @@ -129,7 +130,6 @@ Use Predefined_Hoppings Use LRC_Mod use runtime_error_mod - Implicit none @@ -147,7 +147,6 @@ #ifdef HDF5 procedure, nopass :: write_parameters_hdf5 #endif - end type ham_Hubbard_Plain_Vanilla !#PARAMETERS START# VAR_lattice @@ -159,14 +158,12 @@ !#PARAMETERS START# VAR_Hubbard_Plain_Vanilla real(Kind=Kind(0.d0)) :: ham_T = 1.d0 ! Hopping parameter -!!!!!!! Modifications for Exercise 1a - real (Kind=Kind(0.d0)) :: Ham_Ty = 1.d0 ! Hopping parameter in y -!!!!!!! real(Kind=Kind(0.d0)) :: Ham_chem = 0.d0 ! Chemical potential real(Kind=Kind(0.d0)) :: Ham_U = 4.d0 ! Hubbard interaction real(Kind=Kind(0.d0)) :: Dtau = 0.1d0 ! Thereby Ltrot=Beta/dtau real(Kind=Kind(0.d0)) :: Beta = 5.d0 ! Inverse temperature !logical :: Projector= .false. ! Whether the projective algorithm is used + logical :: Adiabatic= .false. ! If true, and projector true then adiabatic switching on of U. real(Kind=Kind(0.d0)) :: Theta = 10.d0 ! Projection parameter !logical :: Symm = .true. ! Whether symmetrization takes place Integer :: N_part = -1 ! Number of particles in trial wave function. If N_part < 0 -> N_part = L1*L2/2 @@ -195,23 +192,13 @@ end Subroutine Ham_Alloc_Hubbard_Plain_Vanilla !-------------------------------------------------------------------- Subroutine Ham_Set - Use QMC_runtime_var - - - #if defined (MPI) || defined(TEMPERING) Use mpi - #endif Implicit none integer :: ierr, nf, unit_info Character (len=64) :: file_info - - if(Sequential) then - Write(error_unit,*) 'Sequential has to be defined for Hamiltonian_Hubbard_Plain_Vanilla (this is not true, just running a test to see if the QMC variables are accessible)' - CALL Terminate_on_error(ERROR_GENERIC,__FILE__,__LINE__) - endif @@ -234,6 +221,11 @@ Subroutine Ham_Set Call Terminate_on_error(ERROR_HAMILTONIAN,__FILE__,__LINE__) endif + if ( (.not. projector) .and. adiabatic) then + write(output_unit,*) "Adiabatic mode is only implemented for projective code." + write(output_unit,*) "Overriding Adiabatic=.True. from parameter files." + endif + if (N_part < 0) N_part = L1*L2/2 Ltrot = nint(beta/dtau) Thtrot = 0 @@ -275,15 +267,13 @@ Subroutine Ham_Set Write(unit_info,*) 'Theta : ', Theta Write(unit_info,*) 'Tau_max : ', beta Write(unit_info,*) '# of particles: ', N_part + Write(unit_info,*) 'Adiabatic switching on of U: ', Adiabatic else Write(unit_info,*) 'Finite temperture version' Write(unit_info,*) 'Beta : ', Beta endif Write(unit_info,*) 'dtau,Ltrot_eff: ', dtau,Ltrot Write(unit_info,*) 't : ', Ham_T -!!!!!!! Modifications for Exercise 1a - Write(unit_info,*) 'ty : ', Ham_Ty -!!!!!!! Write(unit_info,*) 'Ham_U : ', Ham_U Write(unit_info,*) 'Ham_chem : ', Ham_chem If ( Ham_U >=0.d0 .and. Ham_chem == 0.d0 ) then @@ -369,12 +359,8 @@ Subroutine Ham_Hop Op_T(1,nf)%O(Ix, I ) = cmplx(-Ham_T, 0.d0, kind(0.D0)) If ( L2 > 1 ) then Iy = Latt%nnlist(I,0,1) -!!!!!!! Modifications for Exercise 1a - !Op_T(1,nf)%O(I, Iy) = cmplx(-Ham_T, 0.d0, kind(0.D0)) - !Op_T(1,nf)%O(Iy, I ) = cmplx(-Ham_T, 0.d0, kind(0.D0)) - Op_T(1,nf)%O(I, Iy) = cmplx(-Ham_Ty, 0.d0, kind(0.D0)) - Op_T(1,nf)%O(Iy, I ) = cmplx(-Ham_Ty, 0.d0, kind(0.D0)) -!!!!!!! + Op_T(1,nf)%O(I, Iy) = cmplx(-Ham_T, 0.d0, kind(0.D0)) + Op_T(1,nf)%O(Iy, I ) = cmplx(-Ham_T, 0.d0, kind(0.D0)) endif Op_T(1,nf)%O(I, I ) = cmplx(-Ham_chem, 0.d0, kind(0.D0)) Op_T(1,nf)%P(i) = i @@ -418,12 +404,8 @@ Subroutine Ham_Trial() H0(Ix, I ) = -Ham_T*(1.d0 + Delta*cos(Pi*real(Latt%list(I,1) + Latt%list(I,2),Kind(0.d0)))) If (L2 > 1 ) Then Iy = Latt%nnlist(I,0,1) -!!!!!!! Modifications for Exercise 1a - !H0(I, Iy) = -Ham_T *(1.d0 - Delta) - !H0(Iy, I ) = -Ham_T *(1.d0 - Delta) - H0(I, Iy) = -Ham_Ty *(1.d0 - Delta) - H0(Iy, I ) = -Ham_Ty *(1.d0 - Delta) -!!!!!!! + H0(I, Iy) = -Ham_T *(1.d0 - Delta) + H0(Iy, I ) = -Ham_T *(1.d0 - Delta) Endif Enddo Call Diag(H0,U0,E0) @@ -457,7 +439,7 @@ Subroutine Ham_V Use Predefined_Int Implicit none - Integer :: nf, I + Integer :: nf, I, nt Real (Kind=Kind(0.d0)) :: X @@ -475,14 +457,22 @@ Subroutine Ham_V Do i = 1,Ndim Op_V(i,nf)%P(1) = I Op_V(i,nf)%O(1,1) = cmplx(1.d0, 0.d0, kind(0.D0)) - Op_V(i,nf)%g = X*SQRT(CMPLX(DTAU*ham_U/2.d0, 0.D0, kind(0.D0))) + If (Adiabatic) then + Allocate(OP_V(i,nf)%g_t(Ltrot)) + Op_V(i,nf)%g_t = X*SQRT(CMPLX(DTAU*ham_U/2.d0, 0.D0, kind(0.D0))) + do nt = 1, Thtrot + Op_V(i,nf)%g_t(nt) = X*SQRT(CMPLX(DTAU*dble(nt)/dble(thtrot)*ham_U/2.d0, 0.D0, kind(0.D0))) + Op_V(i,nf)%g_t(Ltrot-(nt-1)) = X*SQRT(CMPLX(DTAU*dble(nt)/dble(thtrot)*ham_U/2.d0, 0.D0, kind(0.D0))) + enddo + else + Op_V(i,nf)%g = X*SQRT(CMPLX(DTAU*ham_U/2.d0, 0.D0, kind(0.D0))) + endif Op_V(i,nf)%alpha = cmplx(-0.5d0, 0.d0, kind(0.D0)) Op_V(i,nf)%type = 2 Call Op_set( Op_V(i,nf) ) Enddo Enddo - end Subroutine Ham_V @@ -501,7 +491,7 @@ Subroutine Alloc_obs(Ltau) Integer, Intent(In) :: Ltau Integer :: i, N, Nt Character (len=64) :: Filename - Character (len=2) :: Channel + Character (len=:), allocatable :: Channel ! Scalar observables @@ -873,4 +863,4 @@ Subroutine GRT_reconstruction(GT0, G0T) endif end Subroutine GRT_reconstruction - end submodule ham_Hubbard_Plain_Vanilla_smod \ No newline at end of file + end submodule ham_Hubbard_Plain_Vanilla_smod diff --git a/Prog/QMC_runtime_var_mod.F90 b/Prog/MC_runtime_var_mod.F90 similarity index 98% rename from Prog/QMC_runtime_var_mod.F90 rename to Prog/MC_runtime_var_mod.F90 index 66e4504f1..e7861c5b0 100644 --- a/Prog/QMC_runtime_var_mod.F90 +++ b/Prog/MC_runtime_var_mod.F90 @@ -29,7 +29,7 @@ ! - 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 +Module MC_runtime_var Use UDV_State_mod @@ -90,4 +90,4 @@ Module QMC_runtime_var character(64) :: chunk_size_str Real (Kind=Kind(0.d0)) :: chunk_size_gb -end Module QMC_runtime_var \ No newline at end of file +end Module MC_runtime_var \ No newline at end of file diff --git a/Prog/Makefile b/Prog/Makefile index 9568a9db3..0cf1df124 100644 --- a/Prog/Makefile +++ b/Prog/Makefile @@ -7,11 +7,11 @@ 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 QMC_runtime_var_mod.o \ + Global_mod.o Langevin_HMC_mod.o Wrapgr_mod.o tau_m_mod.o tau_p_mod.o MC_runtime_var_mod.o \ main.o MODS = control.mod fields_mod.mod global_mod.mod hop_mod.mod lrc_mod.mod observables.mod \ - QMC_runtime_var_mod.mod operator_mod.mod predefined_int.mod predefined_lattices.mod predefined_obs.mod \ + MC_runtime_var_mod.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 \ 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 \ diff --git a/Prog/main.F90 b/Prog/main.F90 index 9d064a15d..4b5dc736d 100644 --- a/Prog/main.F90 +++ b/Prog/main.F90 @@ -114,7 +114,7 @@ Program Main - Use QMC_runtime_var + Use MC_runtime_var Use runtime_error_mod Use Operator_mod Use Lattices_v3 From 1b873a2d5cac0694986f150a6c2f68f1b405e361 Mon Sep 17 00:00:00 2001 From: Lidia Date: Mon, 4 Aug 2025 16:08:45 +0200 Subject: [PATCH 04/17] rename MC_runtime_var -> QMC_runtime_var --- Prog/Makefile | 4 ++-- Prog/{MC_runtime_var_mod.F90 => QMC_runtime_var_mod.F90} | 4 ++-- Prog/main.F90 | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) rename Prog/{MC_runtime_var_mod.F90 => QMC_runtime_var_mod.F90} (98%) diff --git a/Prog/Makefile b/Prog/Makefile index 0cf1df124..9568a9db3 100644 --- a/Prog/Makefile +++ b/Prog/Makefile @@ -7,11 +7,11 @@ 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 MC_runtime_var_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 \ - MC_runtime_var_mod.mod operator_mod.mod predefined_int.mod predefined_lattices.mod predefined_obs.mod \ + QMC_runtime_var_mod.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 \ 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 \ diff --git a/Prog/MC_runtime_var_mod.F90 b/Prog/QMC_runtime_var_mod.F90 similarity index 98% rename from Prog/MC_runtime_var_mod.F90 rename to Prog/QMC_runtime_var_mod.F90 index e7861c5b0..66e4504f1 100644 --- a/Prog/MC_runtime_var_mod.F90 +++ b/Prog/QMC_runtime_var_mod.F90 @@ -29,7 +29,7 @@ ! - 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 MC_runtime_var +Module QMC_runtime_var Use UDV_State_mod @@ -90,4 +90,4 @@ Module MC_runtime_var character(64) :: chunk_size_str Real (Kind=Kind(0.d0)) :: chunk_size_gb -end Module MC_runtime_var \ No newline at end of file +end Module QMC_runtime_var \ No newline at end of file diff --git a/Prog/main.F90 b/Prog/main.F90 index 4b5dc736d..9d064a15d 100644 --- a/Prog/main.F90 +++ b/Prog/main.F90 @@ -114,7 +114,7 @@ Program Main - Use MC_runtime_var + Use QMC_runtime_var Use runtime_error_mod Use Operator_mod Use Lattices_v3 From 73ecab1ddac703e9f86a00cb0da6b784eb08495d Mon Sep 17 00:00:00 2001 From: Lidia Date: Wed, 6 Aug 2025 17:06:23 +0200 Subject: [PATCH 05/17] reorder QMC_runtime_var_mod.mod alphabetically --- Prog/Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Prog/Makefile b/Prog/Makefile index 9568a9db3..dca97025e 100644 --- a/Prog/Makefile +++ b/Prog/Makefile @@ -11,8 +11,8 @@ OBJS = Hamiltonians/LRC_mod.o control_mod.o Fields_mod.o Operator_mod.o WaveFunc main.o MODS = control.mod fields_mod.mod global_mod.mod hop_mod.mod lrc_mod.mod observables.mod \ - QMC_runtime_var_mod.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 \ + operator_mod.mod predefined_int.mod predefined_lattices.mod predefined_obs.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 From 3395d2099a76dd3c4f9691d12f45149f8f36b1b3 Mon Sep 17 00:00:00 2001 From: Lidia Date: Wed, 6 Aug 2025 17:07:16 +0200 Subject: [PATCH 06/17] move runtime initialization and broadcast to QMC_runtime_var_mod --- Prog/QMC_runtime_var_mod.F90 | 81 ++++++++++++++++++++--------- Prog/main.F90 | 99 ++++++++++++++++++------------------ 2 files changed, 107 insertions(+), 73 deletions(-) diff --git a/Prog/QMC_runtime_var_mod.F90 b/Prog/QMC_runtime_var_mod.F90 index 66e4504f1..b7f460448 100644 --- a/Prog/QMC_runtime_var_mod.F90 +++ b/Prog/QMC_runtime_var_mod.F90 @@ -31,8 +31,6 @@ Module QMC_runtime_var - Use UDV_State_mod - Implicit none Integer :: Nwrap, NSweep, NBin, NBin_eff,Ltau, NSTM, NT, NT1, NVAR, LOBS_EN, LOBS_ST, NBC, NSW @@ -51,7 +49,8 @@ Module QMC_runtime_var Logical :: Sequential real (Kind=Kind(0.d0)) :: Amplitude ! Needed for update of type 3 and 4 fields. -! Space for reading in Langevin & HMC parameters + + ! 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 @@ -62,32 +61,66 @@ Module QMC_runtime_var & 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 +!-------------------------------------------------------------------- +!> @author +!> ALF-project +!> +!> @brief +!> Initialization of the QMC runtime variables +!> +! +!-------------------------------------------------------------------- + contains + subroutine set_QMC_runtime_default_var() - ! General - Integer :: Ierr, I,nf, nf_eff, nst, n, n1, N_op - 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 - Real (Kind=Kind(0.d0)) :: Mc_step_weight + 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 - ! Storage for stabilization steps - Integer, dimension(:), allocatable :: Stab_nt + end subroutine set_QMC_runtime_default_var - ! Space for storage. - CLASS(UDV_State), Dimension(:,:), ALLOCATABLE :: udvst - ! For tests - Real (Kind=Kind(0.d0)) :: Weight, Weight_tot +#ifdef MPI +!-------------------------------------------------------------------- +!> @author +!> ALF-project +!> +!> @brief +!> Bradcastinf of the QMC runtime variables +!> +! +!-------------------------------------------------------------------- + subroutine broadcast_QMC_runtime_var() - ! For the truncation of the program: - logical :: prog_truncation, run_file_exists - integer (kind=kind(0.d0)) :: count_bin_start, count_bin_end - - ! For MPI shared memory - character(64), parameter :: name="ALF_SHM_CHUNK_SIZE_GB" - character(64) :: chunk_size_str - Real (Kind=Kind(0.d0)) :: chunk_size_gb + implicit none + 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) + end subroutine broadcast_QMC_runtime_var +#endif + end Module QMC_runtime_var \ No newline at end of file diff --git a/Prog/main.F90 b/Prog/main.F90 index 9d064a15d..e0cea839b 100644 --- a/Prog/main.F90 +++ b/Prog/main.F90 @@ -113,10 +113,13 @@ Program Main - - Use QMC_runtime_var + +#ifdef MPI + Use mpi +#endif Use runtime_error_mod Use Operator_mod + Use QMC_runtime_var Use Lattices_v3 Use MyMats Use Hamiltonian_main @@ -125,6 +128,7 @@ Program Main Use Tau_p_mod Use Hop_mod Use Global_mod + Use UDV_State_mod Use Wrapgr_mod Use Fields_mod Use WaveFunction_mod @@ -135,11 +139,7 @@ Program Main use wrapul_mod use cgr1_mod use set_random - -#ifdef MPI - Use mpi -#endif - + #ifdef HDF5 use hdf5 use h5lt @@ -163,10 +163,36 @@ Program Main 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_HAM_NAME/ ham_name + + !General + Integer :: Ierr, I,nf, nf_eff, nst, n, n1, N_op + 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 + Real (Kind=Kind(0.d0)) :: Mc_step_weight + + ! Storage for stabilization steps + Integer, dimension(:), allocatable :: Stab_nt + + ! 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 + + ! For MPI shared memory + character(64), parameter :: name="ALF_SHM_CHUNK_SIZE_GB" + character(64) :: chunk_size_str + Real (Kind=Kind(0.d0)) :: chunk_size_gb + #ifdef MPI Integer :: Isize, Irank, Irank_g, Isize_g, color, key, igroup, MPI_COMM_i - CALL MPI_INIT(ierr) CALL MPI_COMM_SIZE(MPI_COMM_WORLD,ISIZE,IERR) CALL MPI_COMM_RANK(MPI_COMM_WORLD,IRANK,IERR) @@ -280,49 +306,24 @@ Program Main #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 + + 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) + 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 broadcast_QMC_runtime_var() #endif + Call Fields_init(Amplitude) Call Alloc_Ham(ham_name) leap_frog_bulk = .false. From 940d96f25c67b642c0f9e6c6a10bb3f6f1e70dc7 Mon Sep 17 00:00:00 2001 From: Lidia Date: Thu, 7 Aug 2025 16:21:32 +0200 Subject: [PATCH 07/17] fix mpi variable init and moving var to main --- Prog/QMC_runtime_var_mod.F90 | 18 ++++++++++-------- Prog/main.F90 | 8 +++++++- 2 files changed, 17 insertions(+), 9 deletions(-) diff --git a/Prog/QMC_runtime_var_mod.F90 b/Prog/QMC_runtime_var_mod.F90 index b7f460448..256c53b02 100644 --- a/Prog/QMC_runtime_var_mod.F90 +++ b/Prog/QMC_runtime_var_mod.F90 @@ -31,15 +31,14 @@ Module QMC_runtime_var +#ifdef MPI + Use mpi +#endif + Implicit none 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 @@ -87,8 +86,6 @@ subroutine set_QMC_runtime_default_var() end subroutine set_QMC_runtime_default_var - -#ifdef MPI !-------------------------------------------------------------------- !> @author !> ALF-project @@ -98,10 +95,14 @@ end subroutine set_QMC_runtime_default_var !> ! !-------------------------------------------------------------------- - subroutine broadcast_QMC_runtime_var() +#ifdef MPI + + subroutine broadcast_QMC_runtime_var(MPI_COMM_i) implicit none + Integer :: ierr, MPI_COMM_i + 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) @@ -120,6 +121,7 @@ subroutine broadcast_QMC_runtime_var() 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) + end subroutine broadcast_QMC_runtime_var #endif diff --git a/Prog/main.F90 b/Prog/main.F90 index e0cea839b..66cd9f218 100644 --- a/Prog/main.F90 +++ b/Prog/main.F90 @@ -152,6 +152,11 @@ Program Main CLASS(UDV_State), DIMENSION(:), ALLOCATABLE :: udvl, udvr COMPLEX (Kind=Kind(0.d0)), Dimension(:) , Allocatable :: Phase_array + Integer :: NTAU, NTAU1 + 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 + #ifdef HDF5 INTEGER(HID_T) :: file_id @@ -306,6 +311,7 @@ Program Main #else file_para = "parameters" #endif + Call set_QMC_runtime_default_var() OPEN(UNIT=5,FILE=file_para,STATUS='old',ACTION='read',IOSTAT=ierr) @@ -321,7 +327,7 @@ Program Main #ifdef MPI Endif - call broadcast_QMC_runtime_var() + call broadcast_QMC_runtime_var(MPI_COMM_i) #endif Call Fields_init(Amplitude) From 86ee3a0f15097780667a4021c3eb8e0bface19d7 Mon Sep 17 00:00:00 2001 From: Lidia Date: Fri, 8 Aug 2025 11:07:44 +0200 Subject: [PATCH 08/17] fix missing broadcasting of runtime variables --- Prog/QMC_runtime_var_mod.F90 | 6 +++++- Prog/main.F90 | 2 ++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/Prog/QMC_runtime_var_mod.F90 b/Prog/QMC_runtime_var_mod.F90 index 256c53b02..8f44a43e7 100644 --- a/Prog/QMC_runtime_var_mod.F90 +++ b/Prog/QMC_runtime_var_mod.F90 @@ -91,7 +91,7 @@ end subroutine set_QMC_runtime_default_var !> ALF-project !> !> @brief -!> Bradcastinf of the QMC runtime variables +!> Bradcast of the QMC runtime variables !> ! !-------------------------------------------------------------------- @@ -121,6 +121,10 @@ subroutine broadcast_QMC_runtime_var(MPI_COMM_i) 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 diff --git a/Prog/main.F90 b/Prog/main.F90 index 66cd9f218..ddef7e937 100644 --- a/Prog/main.F90 +++ b/Prog/main.F90 @@ -328,6 +328,8 @@ Program Main #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 Call Fields_init(Amplitude) From a5d09b1038cad8fbf2c7db7453e84f3470d6567f Mon Sep 17 00:00:00 2001 From: Lidia Date: Fri, 15 Aug 2025 16:00:56 +0200 Subject: [PATCH 09/17] move parts of warnings for schemes/variables incompatibility to QMC_runtime_var --- Prog/QMC_runtime_var_mod.F90 | 161 +++++++++++++++++++++++++++-------- Prog/main.F90 | 90 ++++---------------- 2 files changed, 144 insertions(+), 107 deletions(-) diff --git a/Prog/QMC_runtime_var_mod.F90 b/Prog/QMC_runtime_var_mod.F90 index 8f44a43e7..6d061406d 100644 --- a/Prog/QMC_runtime_var_mod.F90 +++ b/Prog/QMC_runtime_var_mod.F90 @@ -30,6 +30,8 @@ ! 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 @@ -37,7 +39,7 @@ Module QMC_runtime_var Implicit none - Integer :: Nwrap, NSweep, NBin, NBin_eff,Ltau, NSTM, NT, NT1, NVAR, LOBS_EN, LOBS_ST, NBC, NSW + Integer :: Nwrap, NSweep, NBin, NBin_eff,Ltau, NSTM, NT, NT1, NVAR, LOBS_EN, LOBS_ST Real(Kind=Kind(0.d0)) :: CPU_MAX ! Space for choosing sampling scheme Logical :: Propose_S0, Tempering_calc_det @@ -75,17 +77,104 @@ Module QMC_runtime_var contains subroutine set_QMC_runtime_default_var() - implicit none + 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 + ! 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(LOBS_ST, LOBS_EN, Thtrot, Ltrot, Projector) + + implicit none + + Integer :: LOBS_ST, LOBS_EN + 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() + 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 +#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 +#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 + + !-------------------------------------------------------------------- !> @author !> ALF-project @@ -99,34 +188,38 @@ end subroutine set_QMC_runtime_default_var subroutine broadcast_QMC_runtime_var(MPI_COMM_i) - implicit none - - Integer :: ierr, MPI_COMM_i - - 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) + 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 + + end Module QMC_runtime_var \ No newline at end of file diff --git a/Prog/main.F90 b/Prog/main.F90 index ddef7e937..0e7dfba73 100644 --- a/Prog/main.F90 +++ b/Prog/main.F90 @@ -151,7 +151,8 @@ Program Main 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_para, file_dat, file_info, ham_name Integer :: Seed_in @@ -395,32 +396,9 @@ 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 + + Call set_default_values_measuring_interval(LOBS_ST, LOBS_ST, Thtrot, Ltrot, Projector) + If ( .not. Global_tau_moves ) then ! This corresponds to the default updating scheme Nt_sequential_start = 1 @@ -499,62 +477,28 @@ Program Main ! 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 (Langevin) then #if defined(MPI) - 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 -#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 ( Irank_g == 0 ) then #endif + Call check_langevin_schemes_and_variables() #if defined(MPI) - endif + endif #endif - Sequential = .False. - HMC = .False. - Global_moves = .False. - Global_tau_moves = .False. + Sequential = .False. + HMC = .False. + Global_moves = .False. + Global_tau_moves = .False. #if defined(TEMPERING) N_exchange_steps = 0 #endif - endif - Call Langevin_HMC%make(Langevin, HMC , Delta_t_Langevin_HMC, Max_Force, Leapfrog_steps) + endif + Call Langevin_HMC%make(Langevin, HMC , Delta_t_Langevin_HMC, Max_Force, Leapfrog_steps) else - Call Langevin_HMC%set_Update_scheme(Langevin, 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. ." + Call Langevin_HMC%set_Update_scheme(Langevin, HMC ) 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" From dedfb0f2c3d533eece5b32659f2ae2838ce0cd50 Mon Sep 17 00:00:00 2001 From: Lidia Date: Mon, 18 Aug 2025 10:47:07 +0200 Subject: [PATCH 10/17] fix non-initialized variable for tempering --- Prog/QMC_runtime_var_mod.F90 | 11 ++++------- Prog/main.F90 | 6 ++++++ 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/Prog/QMC_runtime_var_mod.F90 b/Prog/QMC_runtime_var_mod.F90 index 6d061406d..7f65d4f5c 100644 --- a/Prog/QMC_runtime_var_mod.F90 +++ b/Prog/QMC_runtime_var_mod.F90 @@ -127,6 +127,9 @@ 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." @@ -143,14 +146,8 @@ subroutine check_langevin_schemes_and_variables() write(output_unit,*) "Langevin mode does not allow global tau updates." write(output_unit,*) "Overriding Global_tau_moves=.True. from parameter files." endif -#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 -#endif + end subroutine check_langevin_schemes_and_variables - ! Raise warnings for update schemes subroutine check_update_schemes_compatibility() diff --git a/Prog/main.F90 b/Prog/main.F90 index 0e7dfba73..dacbf1cac 100644 --- a/Prog/main.F90 +++ b/Prog/main.F90 @@ -482,6 +482,12 @@ Program Main if ( Irank_g == 0 ) then #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 +#endif #if defined(MPI) endif #endif From ccee745b2b07e8ca9dc0ec444817873866e55315 Mon Sep 17 00:00:00 2001 From: Lidia Date: Wed, 20 Aug 2025 13:04:59 +0200 Subject: [PATCH 11/17] declare LOBS_ST, LOBS_EN as inout variables for related subroutine --- Prog/QMC_runtime_var_mod.F90 | 2 +- Prog/main.F90 | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/Prog/QMC_runtime_var_mod.F90 b/Prog/QMC_runtime_var_mod.F90 index 7f65d4f5c..fc0cd5288 100644 --- a/Prog/QMC_runtime_var_mod.F90 +++ b/Prog/QMC_runtime_var_mod.F90 @@ -93,7 +93,7 @@ subroutine set_default_values_measuring_interval(LOBS_ST, LOBS_EN, Thtrot, Ltrot implicit none - Integer :: LOBS_ST, LOBS_EN + Integer, intent(inout) :: LOBS_ST, LOBS_EN Integer, intent(in) :: Thtrot, Ltrot Logical, intent(in) :: Projector diff --git a/Prog/main.F90 b/Prog/main.F90 index dacbf1cac..5dc747947 100644 --- a/Prog/main.F90 +++ b/Prog/main.F90 @@ -172,11 +172,11 @@ Program Main NAMELIST /VAR_HAM_NAME/ ham_name !General - Integer :: Ierr, I,nf, nf_eff, nst, n, n1, N_op - 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 - Real (Kind=Kind(0.d0)) :: Mc_step_weight + Integer :: Ierr, I,nf, nf_eff, nst, n, n1, N_op + 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 + Real (Kind=Kind(0.d0)) :: Mc_step_weight ! Storage for stabilization steps Integer, dimension(:), allocatable :: Stab_nt @@ -486,7 +486,7 @@ Program Main 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 + endif #endif #if defined(MPI) endif From d803a2d0cf87ed02c3cbf11b933aff88148bcbf8 Mon Sep 17 00:00:00 2001 From: Lidia Date: Wed, 20 Aug 2025 13:34:51 +0200 Subject: [PATCH 12/17] remove redefinition of LOBS_EN, LOBS_ST --- Prog/QMC_runtime_var_mod.F90 | 5 ++--- Prog/main.F90 | 3 ++- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/Prog/QMC_runtime_var_mod.F90 b/Prog/QMC_runtime_var_mod.F90 index fc0cd5288..f4c5c1976 100644 --- a/Prog/QMC_runtime_var_mod.F90 +++ b/Prog/QMC_runtime_var_mod.F90 @@ -39,7 +39,7 @@ Module QMC_runtime_var Implicit none - Integer :: Nwrap, NSweep, NBin, NBin_eff,Ltau, NSTM, NT, NT1, NVAR, LOBS_EN, LOBS_ST + Integer :: Nwrap, NSweep, NBin, NBin_eff,Ltau, LOBS_EN, LOBS_ST Real(Kind=Kind(0.d0)) :: CPU_MAX ! Space for choosing sampling scheme Logical :: Propose_S0, Tempering_calc_det @@ -89,11 +89,10 @@ subroutine set_QMC_runtime_default_var() end subroutine set_QMC_runtime_default_var - subroutine set_default_values_measuring_interval(LOBS_ST, LOBS_EN, Thtrot, Ltrot, Projector) + subroutine set_default_values_measuring_interval(Thtrot, Ltrot, Projector) implicit none - Integer, intent(inout) :: LOBS_ST, LOBS_EN Integer, intent(in) :: Thtrot, Ltrot Logical, intent(in) :: Projector diff --git a/Prog/main.F90 b/Prog/main.F90 index 5dc747947..c8af62a94 100644 --- a/Prog/main.F90 +++ b/Prog/main.F90 @@ -172,6 +172,7 @@ Program Main NAMELIST /VAR_HAM_NAME/ ham_name !General + Integer :: NSTM, NT, NT1, NVAR Integer :: Ierr, I,nf, nf_eff, nst, n, n1, N_op Logical :: Toggle, Toggle1 Complex (Kind=Kind(0.d0)) :: Z_ONE = cmplx(1.d0, 0.d0, kind(0.D0)), Phase, Z, Z1 @@ -397,7 +398,7 @@ Program Main enddo endif - Call set_default_values_measuring_interval(LOBS_ST, LOBS_ST, Thtrot, Ltrot, Projector) + Call set_default_values_measuring_interval(Thtrot, Ltrot, Projector) If ( .not. Global_tau_moves ) then ! This corresponds to the default updating scheme From 7c578973b45299b0e6755012bd64cc7ca4b809bd Mon Sep 17 00:00:00 2001 From: Johannes Hofmann Date: Fri, 12 Sep 2025 15:51:42 +0200 Subject: [PATCH 13/17] moving Nbins_eff back to main, putting tempering settings in new module --- Prog/QMC_runtime_var_mod.F90 | 36 ++++++++++++++++++++++++++++++++++-- Prog/main.F90 | 23 +++-------------------- 2 files changed, 37 insertions(+), 22 deletions(-) diff --git a/Prog/QMC_runtime_var_mod.F90 b/Prog/QMC_runtime_var_mod.F90 index 8f44a43e7..4adaeca62 100644 --- a/Prog/QMC_runtime_var_mod.F90 +++ b/Prog/QMC_runtime_var_mod.F90 @@ -37,7 +37,7 @@ Module QMC_runtime_var Implicit none - Integer :: Nwrap, NSweep, NBin, NBin_eff,Ltau, NSTM, NT, NT1, NVAR, LOBS_EN, LOBS_ST, NBC, NSW + Integer :: Nwrap, NSweep, NBin,Ltau, NSTM, NT, NT1, NVAR, LOBS_EN, LOBS_ST, NBC, NSW Real(Kind=Kind(0.d0)) :: CPU_MAX ! Space for choosing sampling scheme Logical :: Propose_S0, Tempering_calc_det @@ -53,7 +53,12 @@ Module QMC_runtime_var 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, & @@ -128,5 +133,32 @@ subroutine broadcast_QMC_runtime_var(MPI_COMM_i) 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 end Module QMC_runtime_var \ No newline at end of file diff --git a/Prog/main.F90 b/Prog/main.F90 index ddef7e937..b28559213 100644 --- a/Prog/main.F90 +++ b/Prog/main.F90 @@ -162,16 +162,11 @@ Program Main INTEGER(HID_T) :: file_id Logical :: file_exists #endif - - -#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_HAM_NAME/ ham_name !General - Integer :: Ierr, I,nf, nf_eff, nst, n, n1, N_op + Integer :: Ierr, I,nf, nf_eff, nst, n, n1, N_op, NBin_eff 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 @@ -242,19 +237,7 @@ 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) + call read_and_broadcast_TEMPERING_var() if ( mod(ISIZE,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__) From 281ef692a4308d1e73fed43646e2552a9fc79b2b Mon Sep 17 00:00:00 2001 From: Jonas Schwab Date: Tue, 23 Sep 2025 14:31:28 +0200 Subject: [PATCH 14/17] Moved reading of VAR_QMC and ham_name into QMC_runtime_var_mod --- Prog/QMC_runtime_var_mod.F90 | 53 ++++++++++++++++++++++++++++++++++++ Prog/main.F90 | 39 ++------------------------ 2 files changed, 55 insertions(+), 37 deletions(-) diff --git a/Prog/QMC_runtime_var_mod.F90 b/Prog/QMC_runtime_var_mod.F90 index 38b672844..94cdba450 100644 --- a/Prog/QMC_runtime_var_mod.F90 +++ b/Prog/QMC_runtime_var_mod.F90 @@ -50,11 +50,17 @@ Module QMC_runtime_var 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 + +#ifdef MPI + Integer :: Isize, Irank, Irank_g, Isize_g, color, key, igroup +#endif #if defined(TEMPERING) @@ -67,6 +73,8 @@ Module QMC_runtime_var & 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 @@ -249,5 +257,50 @@ 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 + + +#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 42e51fcff..8fc533df3 100644 --- a/Prog/main.F90 +++ b/Prog/main.F90 @@ -154,7 +154,7 @@ Program Main Integer :: NBC, NSW Integer :: NTAU, NTAU1 - Character (len=64) :: file_seeds, file_para, file_dat, file_info, ham_name + Character (len=64) :: file_seeds, file_dat, file_info Integer :: Seed_in Complex (Kind=Kind(0.d0)) , allocatable, dimension(:,:) :: Initial_field @@ -163,8 +163,6 @@ Program Main INTEGER(HID_T) :: file_id Logical :: file_exists #endif - - NAMELIST /VAR_HAM_NAME/ ham_name !General Integer :: NSTM, NT, NT1, NVAR @@ -194,7 +192,6 @@ Program Main #ifdef MPI - Integer :: Isize, Irank, Irank_g, Isize_g, color, key, igroup, MPI_COMM_i CALL MPI_INIT(ierr) CALL MPI_COMM_SIZE(MPI_COMM_WORLD,ISIZE,IERR) CALL MPI_COMM_RANK(MPI_COMM_WORLD,IRANK,IERR) @@ -282,41 +279,9 @@ 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) - -#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 - - - 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) + call read_and_broadcast_QMC_var_and_ham_name(Group_Comm) NBin_eff = NBin -#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 - Call Fields_init(Amplitude) Call Alloc_Ham(ham_name) leap_frog_bulk = .false. From 24db0d37565abfd3b886dab63fbbcae493fd17d2 Mon Sep 17 00:00:00 2001 From: Jonas Schwab Date: Tue, 23 Sep 2025 14:35:46 +0200 Subject: [PATCH 15/17] main.F90: Remove unused variables --- Prog/main.F90 | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/Prog/main.F90 b/Prog/main.F90 index 8fc533df3..b0241950c 100644 --- a/Prog/main.F90 +++ b/Prog/main.F90 @@ -168,8 +168,8 @@ Program Main Integer :: NSTM, NT, NT1, NVAR Integer :: Ierr, I,nf, nf_eff, nst, n, n1, N_op, NBin_eff 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 @@ -178,9 +178,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 From 0ea3191474d2627d502518bbaafadda4df0a72a2 Mon Sep 17 00:00:00 2001 From: Jonas Schwab Date: Tue, 23 Sep 2025 15:26:09 +0200 Subject: [PATCH 16/17] Move MPI variables back to main.F90 --- Prog/QMC_runtime_var_mod.F90 | 14 +++++++------- Prog/main.F90 | 3 ++- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/Prog/QMC_runtime_var_mod.F90 b/Prog/QMC_runtime_var_mod.F90 index 94cdba450..0283005fa 100644 --- a/Prog/QMC_runtime_var_mod.F90 +++ b/Prog/QMC_runtime_var_mod.F90 @@ -57,10 +57,6 @@ Module QMC_runtime_var Logical :: Langevin, HMC Integer :: Leapfrog_Steps, N_HMC_sweeps Real (Kind=Kind(0.d0)) :: Delta_t_Langevin_HMC, Max_Force - -#ifdef MPI - Integer :: Isize, Irank, Irank_g, Isize_g, color, key, igroup -#endif #if defined(TEMPERING) @@ -269,8 +265,12 @@ subroutine read_and_broadcast_QMC_var_and_ham_name(Group_Comm) integer :: ierr Character (len=64) :: file_para #ifdef MPI - Integer :: MPI_COMM_i + 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 @@ -288,8 +288,8 @@ subroutine read_and_broadcast_QMC_var_and_ham_name(Group_Comm) 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__) + 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) diff --git a/Prog/main.F90 b/Prog/main.F90 index b0241950c..b116a8f00 100644 --- a/Prog/main.F90 +++ b/Prog/main.F90 @@ -187,8 +187,9 @@ Program Main character(64) :: chunk_size_str Real (Kind=Kind(0.d0)) :: chunk_size_gb - #ifdef MPI + Integer :: Isize, Irank, Irank_g, Isize_g, color, key, igroup + CALL MPI_INIT(ierr) CALL MPI_COMM_SIZE(MPI_COMM_WORLD,ISIZE,IERR) CALL MPI_COMM_RANK(MPI_COMM_WORLD,IRANK,IERR) From 0344a0722a1bcf6b6c226dfe684e7cec705beb72 Mon Sep 17 00:00:00 2001 From: Jonas Schwab Date: Tue, 28 Oct 2025 19:33:43 +0100 Subject: [PATCH 17/17] QMC_runtime_var: Use setters and getters --- Prog/QMC_runtime_var_mod.F90 | 304 ++++++++++++++++++++++++++++++++++- Prog/main.F90 | 187 ++++++++++----------- 2 files changed, 400 insertions(+), 91 deletions(-) diff --git a/Prog/QMC_runtime_var_mod.F90 b/Prog/QMC_runtime_var_mod.F90 index 0283005fa..d23f31224 100644 --- a/Prog/QMC_runtime_var_mod.F90 +++ b/Prog/QMC_runtime_var_mod.F90 @@ -39,6 +39,9 @@ Module QMC_runtime_var 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 @@ -71,6 +74,52 @@ Module QMC_runtime_var & 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 @@ -83,7 +132,7 @@ Module QMC_runtime_var !> ! !-------------------------------------------------------------------- - contains + contains subroutine set_QMC_runtime_default_var() implicit none @@ -178,6 +227,259 @@ subroutine check_update_schemes_compatibility() 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 !-------------------------------------------------------------------- diff --git a/Prog/main.F90 b/Prog/main.F90 index b116a8f00..a5128163c 100644 --- a/Prog/main.F90 +++ b/Prog/main.F90 @@ -167,6 +167,7 @@ Program Main !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)) :: Phase, Z, Z1 Real (Kind=Kind(0.d0)) :: ZERO = 10D-8 @@ -235,13 +236,13 @@ Program Main #if defined(TEMPERING) && defined(MPI) call read_and_broadcast_TEMPERING_var() - if ( mod(ISIZE,mpi_per_parameter_set) .ne. 0 ) then + 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__) @@ -252,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) @@ -278,10 +279,10 @@ Program Main call Init_Entanglement_replicas(Group_Comm) call read_and_broadcast_QMC_var_and_ham_name(Group_Comm) - NBin_eff = NBin + NBin_eff = get_NBin() - 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 @@ -346,14 +347,20 @@ Program Main Call set_default_values_measuring_interval(Thtrot, Ltrot, Projector) - If ( .not. Global_tau_moves ) then + 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) @@ -375,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 @@ -406,31 +413,31 @@ 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 #endif Call check_langevin_schemes_and_variables() #if defined(TEMPERING) - if ( N_exchange_steps > 0 ) then + 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 @@ -438,17 +445,17 @@ Program Main #if defined(MPI) 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) + endif + 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 Call check_update_schemes_compatibility() @@ -463,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 @@ -506,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 @@ -548,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) @@ -611,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 @@ -698,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) @@ -726,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)) @@ -757,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 @@ -798,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 @@ -884,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 @@ -907,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