10
1
mirror of https://gitlab.com/scemama/qmcchem.git synced 2024-06-21 20:52:06 +02:00
qmcchem/src/simulation.irp.f

376 lines
8.4 KiB
Fortran

BEGIN_PROVIDER [ logical, is_worker ]
implicit none
BEGIN_DOC
! True if the process is a worker process
END_DOC
is_worker = .False.
END_PROVIDER
BEGIN_PROVIDER [ integer, walk_num_tot ]
implicit none
BEGIN_DOC
! Total number of walkers
END_DOC
walk_num_tot = 1000
call get_electrons_elec_walk_num_tot(walk_num_tot)
walk_num_tot = max(walk_num,walk_num_tot)
call iinfo(irp_here,'walk_num', walk_num_tot)
if (walk_num_tot <= 0) then
call abrt(irp_here,'Total number of walkers should be > 0')
endif
END_PROVIDER
BEGIN_PROVIDER [ integer, walk_num ]
&BEGIN_PROVIDER [ integer, walk_num_8 ]
implicit none
BEGIN_DOC
! Number of walkers
END_DOC
walk_num = 100
call get_electrons_elec_walk_num(walk_num)
call iinfo(irp_here,'walk_num', walk_num)
if (walk_num <= 0) then
call abrt(irp_here,'Number of walkers should be > 0')
endif
integer :: mod_align
walk_num_8 = mod_align(walk_num)
END_PROVIDER
BEGIN_PROVIDER [ logical, do_equilibration ]
implicit none
BEGIN_DOC
! Equilibrate walkers
END_DOC
do_equilibration = .True.
if (.not.do_prepare) then
call get_simulation_equilibration(do_equilibration)
endif
call iinfo(irp_here,'equilibration', do_equilibration)
END_PROVIDER
BEGIN_PROVIDER [ logical, do_prepare ]
implicit none
BEGIN_DOC
! If true, prepare new walkers
END_DOC
do_prepare = .False.
END_PROVIDER
BEGIN_PROVIDER [ double precision, block_time ]
implicit none
BEGIN_DOC
! Wall time requested to realize one block
END_DOC
block_time = 30.d0
integer :: block_time_int
call get_simulation_block_time(block_time_int)
if (block_time<= 1) then
call abrt(irp_here,'Block time should be > 1s')
endif
double precision, external :: qmc_ranf
block_time = dble(block_time_int) + qmc_ranf()
call dinfo(irp_here,'block_time',block_time)
END_PROVIDER
BEGIN_PROVIDER [ integer, stop_time ]
implicit none
BEGIN_DOC
! Termination condition of the run
END_DOC
stop_time = 3600*24
call get_simulation_stop_time(stop_time)
call iinfo(irp_here,'stop_time',stop_time)
if (stop_time<= 1) then
call abrt(irp_here,'Stop time should be > 1s')
endif
END_PROVIDER
BEGIN_PROVIDER [ real, time_step ]
&BEGIN_PROVIDER [ real, time_step_inv ]
&BEGIN_PROVIDER [ double precision, dtime_step ]
implicit none
BEGIN_DOC
! time_step : The time step of the random walk
END_DOC
time_step = 0.0
call get_simulation_time_step(time_step)
call rinfo(irp_here,'time_step',time_step)
if (time_step <= 0.) then
call abrt(irp_here,'Time step should be > 0')
endif
dtime_step = dble(time_step)
time_step_inv = 1./time_step
END_PROVIDER
BEGIN_PROVIDER [ double precision, time_step_sq ]
&BEGIN_PROVIDER [ double precision, time_step_exp ]
&BEGIN_PROVIDER [ double precision, time_step_exp_sq ]
&BEGIN_PROVIDER [ double precision, time_step_exp_sq_sq ]
implicit none
BEGIN_DOC
!
! time_step_sq : sqrt(time_step)
!
! time_step_exp = exp(-time_step)
!
! time_step_exp_sq = sqrt(time_step_exp)
!
! time_step_exp_sq_sq = sqrt(time_step_exp_sq)
END_DOC
time_step_sq = sqrt(dble(time_step))
time_step_exp = exp(-dble(time_step))
time_step_exp_sq = sqrt(time_step_exp)
time_step_exp_sq_sq = sqrt(time_step_exp_sq)
END_PROVIDER
BEGIN_PROVIDER [ integer, qmc_method ]
implicit none
include 'types.F'
BEGIN_DOC
! qmc_method : Calculation method. Can be t_VMC, t_DMC, t_SRMC, t_FKMC
END_DOC
character*(32) :: method
method = types(t_VMC)
call get_simulation_method(method)
if (method == types(t_VMC)) then
qmc_method = t_VMC
else if (method == types(t_DMC)) then
qmc_method = t_DMC
else if (method == types(t_SRMC)) then
qmc_method = t_SRMC
else if (method == types(t_FKMC)) then
qmc_method = t_FKMC
else if (method == types(t_PDMC)) then
qmc_method = t_PDMC
else
call abrt(irp_here, 'Method should be ( VMC | DMC | SRMC | FKMC | PDMC )')
endif
call cinfo(irp_here,'qmc_method',trim(method))
END_PROVIDER
BEGIN_PROVIDER [ real, events_num ]
BEGIN_DOC
! Number of Monte Carlo events to average
END_DOC
events_num = real(walk_num)*real(step_num)
END_PROVIDER
BEGIN_PROVIDER [ integer, walk_i ]
BEGIN_DOC
! Current walker
END_DOC
walk_i = 1
END_PROVIDER
BEGIN_PROVIDER [ real, accepted_num ]
&BEGIN_PROVIDER [ real, rejected_num ]
BEGIN_DOC
! Number of accepted steps
! Number of rejected steps
END_DOC
accepted_num= 0.
rejected_num= 0.
END_PROVIDER
BEGIN_PROVIDER [ logical, save_data ]
implicit none
BEGIN_DOC
! If true, the updated simulation data is saved for restart.
END_DOC
save_data = .True.
call get_simulation_save_data(save_data)
call linfo(irp_here,'save_data',save_data)
END_PROVIDER
real function accep_rate()
if ((accepted_num+rejected_num) > 0.) then
accep_rate = accepted_num/(accepted_num+rejected_num)
else
accep_rate = 0.
endif
end
logical function first_step()
first_step = (accepted_num+rejected_num < 1.)
end
subroutine accep_reset
FREE accepted_num
FREE rejected_num
end
BEGIN_PROVIDER [ integer, print_level ]
BEGIN_DOC
! Level of verbosity for standard output printing
END_DOC
print_level = 1
call get_simulation_print_level(print_level)
END_PROVIDER
BEGIN_PROVIDER [ character*(64), hostname]
implicit none
BEGIN_DOC
! Name of the current host
END_DOC
call HOSTNM(hostname)
END_PROVIDER
BEGIN_PROVIDER [ real, nucl_fitcusp_factor ]
&BEGIN_PROVIDER [ logical, do_nucl_fitcusp ]
implicit none
BEGIN_DOC
! The electron-nucleus cusp fitting is done between 0 and r_c,
! where r_c is chosen as nucl_fitcusp_factor * (radius_of_1s AO)
END_DOC
nucl_fitcusp_factor = 0.
call get_simulation_nucl_fitcusp_factor(nucl_fitcusp_factor)
do_nucl_fitcusp = nucl_fitcusp_factor > 0.
call rinfo(irp_here,'nucl_fitcusp_factor',nucl_fitcusp_factor)
END_PROVIDER
BEGIN_PROVIDER [ integer, vmc_algo ]
implicit none
include 'types.F'
BEGIN_DOC
! Type of VMC algorithm: Brownian, MTM or Langevin
END_DOC
character*(32) :: Sampling
Sampling = types(t_Langevin)
call get_simulation_sampling(Sampling)
vmc_algo = 0
if (Sampling == types(t_Brownian)) then
vmc_algo = t_Brownian
else if (Sampling == types(t_Langevin)) then
vmc_algo = t_Langevin
if (qmc_method == t_DMC) then
stop 'Langevin incompatible with DMC'
endif
if (qmc_method == t_SRMC) then
stop 'Langevin incompatible with SRMC'
endif
if (qmc_method == t_FKMC) then
stop 'Langevin incompatible with FKMC'
endif
else if (Sampling == types(t_MTM)) then
vmc_algo = t_MTM
else
call abrt(irp_here,'Sampling should be (Brownian|Langevin)')
endif
call cinfo(irp_here,'Sampling',Sampling)
ASSERT (vmc_algo > 0)
END_PROVIDER
BEGIN_PROVIDER [ character*(512), ezfio_filename ]
implicit none
BEGIN_DOC
! Name of the ezfio file.
! Defined in init_ezfio_filename
END_DOC
integer :: command_argument_count
if (command_argument_count() == 0) then
ezfio_filename = 'NOT_SET'
call ezfio_set_file(ezfio_filename)
else
call get_command_argument(1,ezfio_filename)
if (.not.is_worker) then
call ezfio_set_file(ezfio_filename)
endif
endif
END_PROVIDER
BEGIN_PROVIDER [ character*(128), http_server ]
implicit none
BEGIN_DOC
! Address of the data server
END_DOC
integer :: command_argument_count
if (command_argument_count() > 1) then
call get_command_argument(2,http_server)
else
call get_simulation_http_server(http_server)
endif
END_PROVIDER
subroutine read_do_run(do_run)
implicit none
integer, intent(out) :: do_run
BEGIN_DOC
! Read the do_run variable from the ezfio directory
END_DOC
include 'types.F'
do_run = t_Stopping
call get_simulation_do_run(do_run)
end
BEGIN_PROVIDER [ character*(32), md5_key ]
implicit none
BEGIN_DOC
! Digest of the input
END_DOC
md5_key = ''
call get_simulation_md5_key(md5_key)
if (md5_key == '') then
call abrt(irp_here,'MD5 key of input is absent')
endif
END_PROVIDER
BEGIN_PROVIDER [ double precision, E_trial ]
implicit none
BEGIN_DOC
! Energy of the trial wave function
END_DOC
call get_simulation_e_trial(E_trial)
END_PROVIDER