MPI-SCATCI 2.0
An MPI version of SCATCI
Loading...
Searching...
No Matches
Options_module.f90
Go to the documentation of this file.
1! Copyright 2019
2!
3! For a comprehensive list of the developers that contributed to these codes
4! see the UK-AMOR website.
5!
6! This file is part of UKRmol-in (UKRmol+ suite).
7!
8! UKRmol-in is free software: you can redistribute it and/or modify
9! it under the terms of the GNU General Public License as published by
10! the Free Software Foundation, either version 3 of the License, or
11! (at your option) any later version.
12!
13! UKRmol-in is distributed in the hope that it will be useful,
14! but WITHOUT ANY WARRANTY; without even the implied warranty of
15! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16! GNU General Public License for more details.
17!
18! You should have received a copy of the GNU General Public License
19! along with UKRmol-in (in source/COPYING). Alternatively, you can also visit
20! <https://www.gnu.org/licenses/>.
21
22!> \brief Options module
23!> \authors A Al-Refaie, J Benda
24!> \date 2017 - 2019
25!>
26!> This module reads input namelists and can be used to pass program run information to other modules.
27!> MPI-SCATCI is mostly compatible with SCATCI, except for omission of the following keywords:
28!> - &INPUT: nctgt, gucont, ncont, nobc, thrhm, lusme
29!> - &CINORN: nfta, npflg, itgt, nopvec, ntgt, notgt, ncipfg
30!>
31!> These keywords are ignored in the input. Additionally, MPI-SCATCI understands the following extra
32!> keywords:
33!> - &CINORN: memp, forse, exrc, vecstore, ecp, targmul, targspace, luprop
34!>
35!> \note 30/01/2017 - Ahmed Al-Refaie: Initial version.
36!> \note 16/01/2019 - Jakub Benda: Unifom coding style and expanded documentation.
37!> \note 24/01/2019 - Jakub Benda: Read multiple stacked input configurations.
38!>
39!> \todo Sort the read namelist inputs by `nciset` to avoid error in positioning on output!
40!>
41module options_module
42
43 use const_gbl, only: line_len, stdin, stdout
44 use consts_mpi_ci, only: mxint, no_ci_target, normal_csf, generate_target_wf, diagonalize, default_archer_memory, &
45 scatci_decide, ecp_type_null, save_all_coeffs, no_diagonalization, diagonalize_no_restart, &
46 normal_phase, name_len_max, do_ci_target_contract, prototype_csf, symtype_dinfh
47 use mpi_gbl, only: master, mpiint, mpi_xermsg
48 use precisn, only: longint, wp
49 use scatci_routines, only: rdnfto, movep, mkpt, ham_pars_io
50 use memorymanager_module, only: master_memory
51 use parallelization_module, only: grid => process_grid
52
53 implicit none
54
55 public optionsset, options, phase, ham_pars_io_wrapper
56
57 !> \brief ?
58 !> \authors A Al-Refaie
59 !> \date 2017
60 !>
61 type phase
62 integer :: size_phaze
63 integer, allocatable :: phase_index(:)
64 end type phase
65
66
67 !> \brief Calculation setup for a single Hamiltonian diagonalization
68 !> \authors A Al-Refaie, J Benda
69 !> \date 2017 - 2019
70 !>
71 !> Corresponds to data read from a single pair of &INPUT and &CINORN namelists.
72 !> For default values see the subroutines \ref read_all_input and \ref read_all_cinorn.
73 !>
74 type :: options
75 !--------------SCATCI-INPUTS----------------------------!
76 integer :: megul !< MEGUL
77 integer :: ci_target_flag !< ICITG
78 integer :: csf_type !< IEXPC
79 integer :: ci_target_switch !< NFTG
80 real(wp) :: exotic_mass !< SCALEM
81 real(wp) :: enh_factor !< ENH_FACTOR
82 integer :: enh_factor_type !< ENH_FACTOR_TYPE
83 integer :: diagonalization_flag !< ICIDG
84 integer :: integral_unit !< NFTI
85 integer :: hamiltonian_unit !< NFTE
86 integer :: ci_output_unit !< NFTW
87 integer :: num_matrix_elements_per_rec !< LEMBF
88 integer :: phase_correction_flag !< NCORB
89 integer :: num_eigenpairs !< NSTAT
90 logical :: use_ukrmol_integrals !< UKRMOLP_INTS
91 logical :: quantamoln !< QMOLN
92 integer :: integral_ordering !< IORD
93 integer :: print_dataset_heading !< NPCVC
94 integer :: output_ci_set_number !< NCISET
95 integer(longint) :: total_memory !< MEMP
96 integer :: diagonalizer_choice !< IGH
97 integer :: use_scf !< SCFUSE
98 integer :: force_serial !< FORSE
99 integer :: print_flags(2) !< NPFLG
100
101 !> Old_name:Name given to CSF
102 character(len=NAME_LEN_MAX) :: name
103 character(len=NAME_LEN_MAX) :: diag_name
104
105 !------------Header information on CSF------------------------------!
106 integer :: lambda = 0 !< MGVN - Lambda or IRR for CSF
107 real(wp) :: spin = 0.0_wp !< ISS - Spin value
108 real(wp) :: spin_z = 0.0_wp !< ISZ - Z-Spin
109 real(wp) :: refl_quanta = 0.0_wp !< R - Reflection quanta Sigma+(1.0) Sigma-(-1.0)
110 real(wp) :: pin = 0.0_wp !< PIN - ???
111 integer :: tot_num_orbitals = 0 !< NORB - Total # of Orbitals
112 integer :: tot_num_spin_orbitals = 0 !< NSRB - Total # spin orbitals
113 integer :: num_csfs = 0 !< NOCSF - # of CSFs
114 integer :: num_electrons = 0 !< NELT - # of electrons
115 integer :: length_coeff = 0 !< LCDOF - Length of corresponding coefficients array
116 integer :: matrix_eval = -1 !< IDIAG - Diagonalization flag
117 integer :: num_syms = 0 !< NSYM - # of symmetries
118 integer :: sym_group_flag = 0 !< SYMTYP - Point Group Flag
119 integer :: length_dtrs = 0 !< LNDOF - Length of packed slater determinants
120 integer :: positron_flag = 0 !< IPOSIT - Positron flag
121 integer :: output_flag(6) !< NPFLAG - Output flag for SCATCI ( or SPEEDY)
122 real(wp) :: threshold = 0.0_wp !< thresh -
123 integer :: num_continuum = 0 !< nctarg - Nunber of continuum functions
124 integer :: maximum_num_target_states = 0 !< NMMX - Max number of states
125 integer :: total_num_ci_target = 0 !< NCITOT - Total number of CI components
126 integer :: total_num_target_states = 0 !< NTGT - total number target states
127 integer :: num_target_sym = 0 !< ntgtsym - Number of target symmetries
128 integer :: last_continuum = 0 !< ncont - Number of last CSF containing a continuum orbital
129 integer :: num_expanded_continuum_csf = 0 !< Ncont2 - number of expanded continuum functions
130 integer :: seq_num_last_continuum_csf = 0 !< lcont - Sequence number of last_CSF
131 integer :: continuum_block_size = 0
132 integer :: num_l2_csf = 0 !< - Number of L2 functions
133 integer :: actual_num_csfs = 0 !< MXCSF - Number of actual CSFS
134 integer :: contracted_mat_size = 0 !< MOCSF - Contracted matrix size
135 integer :: total_num_tgt_states = 0 !< NTGT - Total number of starget states
136 integer :: verbosity = 1
137 integer :: exchange_flag = 0 !<NOEX - Switch off exchange between projectile and target electrons
138
139 !---------------allocatable header information----------------!
140 integer, allocatable :: num_orbitals_sym(:) !< NOB - Number of orbitals per symmetry
141 integer, allocatable :: num_electronic_orbitals_sym(:) !< NOBE - Number of electronic orbitals per symmetry
142 integer, allocatable :: num_positron_orbitals_sym(:) !< NOBP - Number of positron orbitals per symmetry
143 integer, allocatable :: num_unused_orbitals_sym(:) !< NOBV - Number of positron orbitals per symmetry
144 integer, allocatable :: reference_dtrs(:) !< NDTRF - Reference determinants
145 integer, allocatable :: num_dtr_csf_out(:) !< NODO - Number of determinants in CSF in output
146 type(phase), allocatable :: ci_phase(:) !< IPHZ - Index of Phase factor
147 integer, allocatable :: phase_index(:)
148 integer, allocatable :: num_orbitals_sym_dinf(:) !< NOBL - The D-inf-h version of NOB
149 integer, allocatable :: num_target_orbitals_sym_congen(:) !< NOB0 - Number of target orbitals for each symmetry from congen
150 integer, allocatable :: num_target_orbitals_sym_dinf_congen(:) !< NOB0L - Number of target orbitals for each symmetry from congen
151 integer, allocatable :: num_target_orbitals_sym(:) !< NOBC - Number of target orbitals for each symmetry (and in a sense their starting point)
152 integer, allocatable :: num_ci_target_sym(:) !< NCTGT - Number of CI components of each target symmetry.
153 integer, allocatable :: num_continuum_orbitals_target(:) !< NOTGT - Number of continuum orbitals associated with each target state.
154 integer, allocatable :: num_target_state_sym(:) !< NUMTGT - Number of target states for each symmetries
155 integer, allocatable :: lambda_continuum_orbitals_target(:) !< MCONT - Lambda value ('symmetry') of the continuum orbitals associated with each target state.
156 integer, allocatable :: gerade_sym_continuum_orbital_target(:) !< GUCONT - Gerade/ungerade symmetry of the continuum orbitals associated with each target state.
157 integer, allocatable :: orbital_sequence_number(:) !< kpt - Pointer to orbital sequence
158 integer, allocatable :: ci_set_number(:) !< NTGTF - Set number on CI unit
159 integer, allocatable :: ci_sequence_number(:) !< NTGTS - Set number on CI unit
160 real(wp), allocatable :: energy_shifts(:) !< ESHIFT - Energy shifts
161
162 !----------------------miscellaneous variables
163 integer, allocatable :: temp_orbs(:)
164
165 !ECP variables
166 integer, allocatable :: target_multiplicity(:)
167 integer, allocatable :: target_spatial(:)
168 logical :: multiplicity_defined = .false.
169 logical :: spatial_defined = .false.
170 logical :: all_ecp_defined = .false.
171 integer :: ecp_type = ecp_type_null
172 character(len=line_len*5) :: ecp_filename
173 integer :: exclude_rowcolumn = -1
174
175 ! Eigenvector output write order
176 integer(mpiint) :: preceding_writer = -1 !< Rank of process that will write the previous dataset into the same file (or -1 if none).
177 integer(mpiint) :: following_writer = -1 !< Rank of process that will write the following dataset into the same file (or -1 if none).
178
179 real(wp) :: eigenvec_conv = 1d-10
180 real(wp) :: residual_conv = 1d-8
181 real(wp) :: orthog_trigger = 1d-7
182 real(wp) :: max_tolerance = 1d-12
183 integer :: max_iterations = -1
184
185 integer :: vector_storage_method = save_all_coeffs
186 contains
187 procedure, public :: read => read_input
188 procedure, private :: read_congen
189 procedure, private :: compute_variables
190 procedure, private :: compute_expansions
191 procedure, private :: check_sanity_congen_header
192 procedure, private :: check_sanity_complete
193 procedure, private :: arrange_phase
194 procedure, public :: do_ci_contraction
195 end type options
196
197
198 !> \brief MPI-SCATCI outer interface
199 !> \authors J Benda
200 !> \date 2024
201 !>
202 !> Extract boundary amplitudes, and/or transition multipoles, and/or write RMT data file.
203 !>
204 !> MPI-SCATCI outer interface uses target properties for construction of
205 !> - inner region transition dipoles (properties read from unit `lutdip`)
206 !> - outer region multipole potentials (properties read from unit `lutarg`)
207 !>
208 type :: interfaceoptions
209 integer, allocatable :: idtarg(:) ! denprop-to-congen state order permutation
210 integer, allocatable :: itspin(:) ! spin multiplicity of each target spin-symmetry used in CI expansion
211 logical :: write_amp = .false. ! write boundary amplitudes (swinterf "fort.21")
212 logical :: write_dip = .false. ! write transition dipole moments (cdenprop_target "fort.624")
213 logical :: write_rmt = .false. ! write RMT input file (rmt_interface "molecular_data")
214 logical :: all_props = .true. ! whether to calculate IRR-with-itself properties and energy-sort states (.true. for RMT)
215 logical :: auto_nvo = .false. ! Automatically determine contracted virtual orbitals
216 integer :: luprop = -1 ! orbital properties file unit to read if different than NFTI
217 integer :: lupropw = 624 ! output unit for CDENPROP properties
218 integer :: lutdip = 24 ! target properties (dipoles) for use in CDENPROP (typically with ISW = 1)
219 integer :: lutarg = 24 ! target properties for use in SWINTERF (typically with ISW = 0)
220 integer :: isw = 0 ! calculate electronic and nuclear (= 0) or electronic only (= 1) propeties in CDENPROP
221 integer :: nfdm ! number of extra R-matrix sub-spheres for RMT (excluding the main R-matrix sphere)
222 integer :: luchan = 10 ! output unit with outer channel descriptions
223 integer :: lurmt = 21 ! output unit with boundary amplitudes
224 real(wp) :: rmatr ! radius of the R-matrix sphere
225 real(wp) :: delta_r ! spacing between the R-matrix sub-spheres
226 character(len=1) :: cform = 'F' ! formatted or unformatted channel description file
227 character(len=1) :: rform = 'U' ! formatted or unformatted R-matrix file
228 end type interfaceoptions
229
230
231 !> \brief MPI-SCATCI input
232 !> \authors J Benda
233 !> \date 2019 - 2024
234 !>
235 !> Input configuration of the calculation as a set of \ref Options types. Typically,
236 !> there is one \ref Options instance for each Hamiltonian (irreducible representation)
237 !> to diagonalize. Also contains data from `&outer_interface` namelists.
238 !>
239 type :: optionsset
240 type(options), allocatable :: opts(:)
241 type(interfaceoptions), allocatable :: interface_opts(:)
242 contains
243 procedure, public :: read => read_all_namelists
244 procedure, private :: read_all_input
245 procedure, private :: read_all_cinorn
246 procedure, private :: read_outer_interface
247 procedure, public :: setup_write_order
248 end type optionsset
249
250contains
251
252 !> \brief Read all relevant namelists from the input
253 !> \authors A Al-Refaie, J Benda
254 !> \date 2017 - 2019
255 !>
256 !> Finds out whether the program received the input file path via the command line; if not, it will be read
257 !> from the standard input. Then reads all &INPUT namelists, followed by all &CINORN namelists. The data read
258 !> from the namelists are used to initialize objects of type \ref Options.
259 !>
260 subroutine read_all_namelists (this)
261
262 class(optionsset), intent(inout) :: this
263
264 integer :: num_arguments, io, err, num_input, num_cinorn, i
265 character(len=800) :: input_filename
266
267 num_arguments = command_argument_count()
268
269 if (num_arguments > 1) then
270 write (stdout, "('Only one argument allowed')")
271 write (stdout, "('Command line must be:')")
272 write (stdout, "('./mpi-scatci <input filename>')")
273 call mpi_xermsg('Options_module', 'read_all_namelists', 'Too many command-line arguments', 1, 1)
274 end if
275
276 if (num_arguments == 1) then
277 call get_command_argument(1, input_filename)
278 input_filename = trim(input_filename)
279
280 open (newunit = io, action = 'read', status = 'old', file = input_filename, iostat = err)
281
282 if (err /= 0) then
283 call mpi_xermsg('Options_module', 'read_all_namelists', 'Could not open input file ' // trim(input_filename), 2, 1)
284 end if
285 else
286 io = stdin
287 end if
288
289 if (allocated(this % opts)) deallocate(this % opts)
290
291 num_input = this % read_all_input(io)
292 num_cinorn = this % read_all_cinorn(io)
293
294 call this % read_outer_interface(io)
295
296 if (io /= stdin) close (io)
297
298 ! we require at least one valid input
299 if (num_input == 0) then
300 call mpi_xermsg('Options_module', 'read_all_namelists', 'Missing &INPUT namelist in the input file', 3, 1)
301 end if
302
303 ! we require equal number of &INPUT and &CINORN namelists
304 if (num_input /= num_cinorn) then
305 call mpi_xermsg('Options_module', 'read_all_namelists', 'Unequal number of &INPUT and &CINORN namelists', 4, 1)
306 end if
307
308 ! let each Options instance finalize itself
309 do i = 1, num_input
310 call this % opts(i) % read
311 end do
312
313 end subroutine read_all_namelists
314
315
316 !> \brief Read all &INPUT namelists from file unit
317 !> \authors J Benda
318 !> \date 2019 - 2022
319 !>
320 !> Reads all &INPUT namelists in the order present in the source file and stores the data
321 !> in the internal array (reallocated whenever necessary).
322 !>
323 !> \param[inout] this OptionSet object to update.
324 !> \param[in] io File unit to process.
325 !>
326 !> \return Number of &INPUT namelists read from the file.
327 !>
328 integer function read_all_input (this, io) result (i)
329
330 use iso_fortran_env, only: iostat_end
331
332 class(optionsset), intent(inout) :: this
333 integer, intent(in) :: io
334
335 type(options), allocatable :: tmp_opts(:)
336 character(NAME_LEN_MAX) :: name
337
338 logical :: qmoln, ukrmolp_ints
339 integer :: icidg, icitg, iexpc, idiag, nfti, nfte, lembf, megul, nftg, ntgsym, ncont, ncorb, iord, scfuse, lusme
340 integer :: io_stat, ierr, nset, nrec, nnuc, nocsf, nstat, mgvn, nelt, k, j, iposit, enh_factor_type, noex
341
342 character(1000) :: io_msg
343 real(wp) :: scalem, thrhm, spin, spinz, e0, enh_factor
344 integer, allocatable :: numtgt(:), notgt(:), nctgt(:), ntgtf(:), ntgts(:), mcont(:), gucont(:), nobc(:)
345
346 namelist /input/ icidg, icitg, iexpc, idiag, nfti, nfte, lembf, megul, nftg, ntgsym, numtgt, notgt, nctgt, ntgtf, ntgts, &
347 mcont, gucont, ncont, ncorb, nobc, iord, name, scalem, scfuse, thrhm, qmoln, ukrmolp_ints, lusme, iposit, &
348 enh_factor, enh_factor_type, noex
349
350 i = 0
351
352 allocate (numtgt(mxint), notgt(mxint), nctgt(mxint), ntgtf(mxint), ntgts(mxint), mcont(mxint), gucont(mxint), &
353 nobc(mxint), stat = ierr)
354
355 if (ierr /= 0) then
356 call mpi_xermsg('Options_module', 'read_all_input', 'Input arrays allocation failure', 1, 1)
357 end if
358
359 rewind(io, iostat = io_stat)
360
361 namelist_loop: do
362
363 ! set namelist entries to their default values
364 icidg = diagonalize
365 icitg = no_ci_target
366 iexpc = normal_csf
367 idiag = -1
368 nfti = 16
369 nfte = 26
370 lembf = 5000
371 megul = 13
372 nftg = generate_target_wf
373 ntgsym = 0
374 numtgt(:) = 0
375 notgt(:) = 0
376 nctgt(:) = 1
377 ntgtf(:) = 0
378 ntgts(:) = 0
379 mcont(:) = 0
380 ncorb = normal_phase
381 iord = 1
382 name = ''
383 scalem = 0
384 scfuse = 0
385 iposit = 0
386 qmoln = .false.
387 enh_factor = 1.0_wp
388 enh_factor_type = 0
389 ukrmolp_ints = .true.
390 noex = 0
391
392 ! read the next &INPUT namelist
393 read (io, nml = input, iostat = io_stat, iomsg = io_msg)
394 if (io_stat == iostat_end) then
395 exit namelist_loop ! no more namelists in the file...
396 end if
397 if (io_stat /= 0) then
398 call mpi_xermsg('Options_module', 'read_all_input', &
399 'Error when reading &INPUT namelist: ' // trim(io_msg), i + 1, 1)
400 end if
401
402 ! seems to be a valid namelist
403 i = i + 1
404
405 ! re-allocate array of Options structures
406 if (allocated(this % opts)) then
407 call move_alloc(this % opts, tmp_opts)
408 end if
409 allocate (this % opts(i), stat = ierr)
410 if (ierr /= 0) then
411 call mpi_xermsg('Options_module', 'read_all_input', 'Input structures allocation failure', 2, 1)
412 end if
413 if (allocated(tmp_opts)) then
414 this % opts(1:size(tmp_opts)) = tmp_opts(:)
415 deallocate (tmp_opts)
416 end if
417
418 ! prevent overflows in below assigments (but should be assured by length check of the namelist data already)
419 if (ntgsym > mxint) then
420 call mpi_xermsg('Options_module', 'read_all_input', 'NTGSYM exceeds built-in limit MXINT', 3, 1)
421 end if
422 this % opts(i) % total_num_tgt_states = sum(numtgt(1:ntgsym))
423 if (this % opts(i) % total_num_tgt_states > mxint) then
424 call mpi_xermsg('Options_module', 'read_all_input', 'Number of target states exceeds built-in limit MXINT', 4, 1)
425 end if
426
427 ! copy data from the namelist to the structure
428 this % opts(i) % diagonalization_flag = icidg
429 this % opts(i) % ci_target_flag = icitg
430 this % opts(i) % csf_type = iexpc
431 this % opts(i) % matrix_eval = idiag
432 this % opts(i) % integral_unit = nfti
433 this % opts(i) % hamiltonian_unit = nfte
434 this % opts(i) % num_matrix_elements_per_rec = lembf
435 this % opts(i) % megul = megul
436 this % opts(i) % ci_target_switch = nftg
437 this % opts(i) % num_target_sym = ntgsym
438
439 if (ntgsym > 0) then
440 call allocate_integer_array(this % opts(i) % num_target_state_sym, ntgsym)
441 call allocate_integer_array(this % opts(i) % num_continuum_orbitals_target, ntgsym)
442 call allocate_integer_array(this % opts(i) % lambda_continuum_orbitals_target, ntgsym)
443 call allocate_integer_array(this % opts(i) % ci_set_number, this % opts(i) % total_num_tgt_states)
444 call allocate_integer_array(this % opts(i) % ci_sequence_number, this % opts(i) % total_num_tgt_states)
445 this % opts(i) % num_target_state_sym = numtgt(1:ntgsym)
446 this % opts(i) % num_continuum_orbitals_target = notgt(1:ntgsym)
447 this % opts(i) % ci_set_number = ntgtf(1:this % opts(i) % total_num_tgt_states)
448 this % opts(i) % ci_sequence_number = ntgts(1:this % opts(i) % total_num_tgt_states)
449 this % opts(i) % lambda_continuum_orbitals_target = mcont(1:ntgsym)
450 end if
451
452 this % opts(i) % phase_correction_flag = ncorb
453 this % opts(i) % integral_ordering = iord
454 this % opts(i) % name = name
455 this % opts(i) % exotic_mass = scalem
456 this % opts(i) % use_SCF = scfuse
457 this % opts(i) % positron_flag = iposit
458 this % opts(i) % enh_factor = enh_factor
459 this % opts(i) % enh_factor_type = enh_factor_type
460 this % opts(i) % QuantaMolN = qmoln
461 this % opts(i) % use_UKRMOL_integrals = ukrmolp_ints
462 this % opts(i) % exchange_flag = noex
463
464 !if ( this % opts(i) % positron_flag /= 0 ) then
465 ! call mpi_xermsg('Options_module', 'read_all_input', &
466 ! 'Positrons are not yet implemented for mpi-scatci.', i, 1)
467 !end if
468
469 ! also read spin-symmetry information about the target states from the target CI expansion coefficients file (if given)
470 if (nftg > 0) then
471 allocate (this % opts(i) % target_spatial(this % opts(i) % total_num_tgt_states), &
472 this % opts(i) % target_multiplicity(this % opts(i) % total_num_tgt_states))
473 do j = 1, this % opts(i) % total_num_tgt_states
474 if (this % opts(i) % ci_set_number(j) <= 0) then
475 call mpi_xermsg('Options_module', 'read_all_input', &
476 'Non-zero NFTG requires setting also non-zero NTGTF/NTGTS.', i, 1)
477 end if
478 call movep(nftg, this % opts(i) % ci_set_number(j), ierr, 0, 0)
479 if (ierr /= 0) then
480 call mpi_xermsg('Options_module', 'read_all_input', &
481 'CI data not found in unit', nftg, 1)
482 end if
483 read (nftg) ! dummy read to skip header
484 read (nftg) nset, nrec, name, nnuc, nocsf, nstat, mgvn, spin, spinz, nelt, e0
485 this % opts(i) % target_spatial(j) = mgvn
486 this % opts(i) % target_multiplicity(j) = nint(2 * spin + 1)
487 end do
488 end if
489
490 end do namelist_loop
491
492 end function read_all_input
493
494
495 !> \brief Read all &CINORN namelists from file unit
496 !> \authors J Benda
497 !> \date 2019
498 !>
499 !> Reads all &CINORN namelists in the order present in the source file and stores the data
500 !> in the internal array (reallocated whenever necessary).
501 !>
502 !> \param[inout] this OptionSet object to update.
503 !> \param[in] io File unit to process.
504 !>
505 !> \return Number of &CINORN namelists read from the file.
506 !>
507 integer function read_all_cinorn (this, io) result (i)
508
509 use iso_fortran_env, only: iostat_end
510 use const_gbl, only: set_verbosity_level
511
512 class(optionsset), intent(inout) :: this
513 integer, intent(in) :: io
514
515 type(options), allocatable :: tmp_opts(:)
516
517 integer :: nfta, nftw, nciset, npflg(2), npcvc, itgt, nopvec, ntgt, notgt, ncipfg, nkey, large, thrprt
518 integer :: keycsf, nstat, igh, maxiter, forse, exrc, vecstore, ecp, targmul(mxint), targspace(mxint)
519 integer :: ierr, io_stat, nshifts, ishift, verbosity
520 real(wp) :: critc, critr, ortho, crite, memp, eshift(mxint)
521
522 character(256) :: io_msg
523 character(NAME_LEN_MAX) :: name
524
525 namelist /cinorn/ nfta, nftw, nciset, npflg, npcvc, name, itgt, nopvec, ntgt, notgt, eshift, ncipfg, nkey, large, thrprt, &
526 keycsf, nstat, igh, critc, critr, ortho, crite, maxiter, memp, forse, exrc, vecstore, ecp, &
527 targmul, targspace, verbosity
528
529 i = 0
530
531 rewind(io, iostat = io_stat)
532
533 namelist_loop: do
534
535 ! set namelist entries to their default values
536 nftw = 25
537 nciset = 1
538 npcvc = 1
539 name = ''
540 nstat = 0
541 igh = scatci_decide
542 critc = 1e-10_wp
543 critr = 1e-08_wp
544 ortho = 1e-07_wp
545 crite = 1e-12_wp
546 maxiter = -1
547 memp = default_archer_memory
548 forse = 0
549 exrc = -1
550 vecstore = save_all_coeffs
551 ecp = ecp_type_null
552 targmul = 0
553 targspace = 0
554 eshift = 0.0_wp
555 npflg = 0
556 verbosity = 1
557
558 ! read the next &CINORN namelist
559 read (io, nml = cinorn, iostat = io_stat, iomsg = io_msg)
560 if (io_stat == iostat_end) then
561 exit namelist_loop ! no more namelists in the file...
562 end if
563 if (io_stat /= 0) then
564 call mpi_xermsg('Options_module', 'read_all_input', &
565 'Error when reading &CINORN namelist: ' // trim(io_msg), i + 1, 1)
566 end if
567
568 ! seems to be a valid namelist
569 i = i + 1
570
571 ! re-allocate array of Options structures as needed
572 if (.not. allocated(this % opts) .or. size(this % opts) < i) then
573 if (allocated(this % opts)) call move_alloc(this % opts, tmp_opts)
574 allocate (this % opts(i), stat = ierr)
575 if (ierr /= 0) then
576 call mpi_xermsg('Options_module', 'read_all_cinorn', 'Input structures allocation failure', 2, 1)
577 end if
578 if (allocated(tmp_opts)) this % opts(1:size(tmp_opts)) = tmp_opts(:)
579 end if
580
581 ! energy shifts: count them (up to the last non-zero specified), allocate a permanent array, and copy data
582 nshifts = 0
583 do ishift = 1, size(eshift)
584 if (eshift(ishift) /= 0) nshifts = ishift
585 end do
586 if (nstat > 0 .and. nshifts > nstat) then
587 call mpi_xermsg('Options_module', 'read_all_cinorn', &
588 'Too many energy shifts given for the given number of eigenpairs', nstat, 1)
589 end if
590 call allocate_real_array(this % opts(i) % energy_shifts, nshifts)
591 if (nshifts > 0) then
592 this % opts(i) % energy_shifts = eshift(1:nshifts)
593 end if
594
595 ! copy data from the namelist to the structure
596 this % opts(i) % CI_output_unit = nftw
597 this % opts(i) % output_ci_set_number = nciset
598 this % opts(i) % print_dataset_heading = npcvc
599 this % opts(i) % diag_name = name
600 this % opts(i) % num_eigenpairs = nstat
601 this % opts(i) % diagonalizer_choice = igh
602 this % opts(i) % eigenvec_conv = critc
603 this % opts(i) % residual_conv = critr
604 this % opts(i) % orthog_trigger = ortho
605 this % opts(i) % max_tolerance = crite
606 this % opts(i) % max_iterations = maxiter
607 this % opts(i) % print_flags = npflg
608
609 ! MPI-SCATCI specific parameters
610 this % opts(i) % total_memory = int(memp * 1024_longint**3, longint)
611 this % opts(i) % force_serial = forse
612 this % opts(i) % exclude_rowcolumn = exrc
613 this % opts(i) % vector_storage_method = vecstore
614 this % opts(i) % ecp_type = ecp
615 this % opts(i) % verbosity = verbosity
616
617 call set_verbosity_level(verbosity)
618
619 end do namelist_loop
620
621 end function read_all_cinorn
622
623
624 !> \brief Read contents of the OUTER interface namelist
625 !> \authors J Benda
626 !> \date 2019 - 2024
627 !>
628 !> Reads setup(s) of the OUTER interfaces(s).
629 !>
630 !> \param[inout] this OptionSet object to update.
631 !> \param[in] io File unit to process.
632 !>
633 subroutine read_outer_interface (this, io)
634
635 use iso_fortran_env, only: iostat_end
636
637 class(optionsset), intent(inout) :: this
638 integer, intent(in) :: io
639
640 type(interfaceoptions), allocatable :: options(:)
641 type(interfaceoptions) :: option
642
643 logical :: write_amp, write_dip, write_rmt, all_props, auto_nvo, is_scattering
644 integer :: luprop, lupropw, lutdip, lutarg, luchan, lurmt, nfdm, io_stat, ntarg, idtarg(mxint), itarget_spin(mxint), isw, n
645 real(wp) :: delta_r, rmatr
646
647 character(1) :: cform, rform
648 character(256) :: io_msg
649 character(900) :: err_msg
650
651 namelist /outer_interface/ write_amp, write_dip, write_rmt, all_props, luprop, nfdm, delta_r, rmatr, ntarg, idtarg, &
652 lutdip, lutarg, lupropw, luchan, lurmt, cform, rform, isw, auto_nvo, itarget_spin
653
654 rewind(io, iostat = io_stat)
655
656 namelist_loop: do
657
658 write_amp = .true.
659 write_dip = .false.
660 write_rmt = .false.
661 all_props = .true.
662 auto_nvo = .false.
663 lutdip = 24
664 lutarg = 24
665 luprop = -1
666 isw = 0
667 nfdm = 18
668 delta_r = 0.08_wp
669 rmatr = -1.0_wp
670 ntarg = 0
671 idtarg = 0
672 itarget_spin = 2
673 lupropw = 624
674 luchan = 10
675 lurmt = 21
676 cform = 'F'
677 rform = 'U'
678
679 read (io, nml = outer_interface, iostat = io_stat, iomsg = io_msg)
680 if (io_stat == iostat_end) then
681 exit namelist_loop ! no more namelists in the file...
682 end if
683 if (io_stat /= 0) then
684 call mpi_xermsg('Options_module', 'read_outer_interface', &
685 'Error when reading &OUTER_INTERFACE namelist: ' // trim(io_msg), 1, 1)
686 end if
687 if (rmatr < 0 .and. (write_amp .or. write_rmt)) then
688 call mpi_xermsg('Options_module', 'read_outer_interface', 'Missing "rmatr" in &outer_interface namelist.', 1, 1)
689 end if
690
691 option % write_amp = write_amp
692 option % write_dip = write_dip
693 option % write_rmt = write_rmt
694 option % all_props = all_props
695 option % auto_nvo = auto_nvo
696 option % lutdip = lutdip
697 option % lutarg = lutarg
698 option % luprop = luprop
699 option % itspin = itarget_spin
700 option % isw = isw
701 option % nfdm = nfdm
702 option % delta_r = delta_r
703 option % rmatr = rmatr
704 option % lupropw = lupropw
705 option % luchan = luchan
706 option % lurmt = lurmt
707 option % cform = cform
708 option % rform = rform
709
710 if (ntarg > 0) then
711 option % idtarg = idtarg(1:ntarg)
712 if (any(option % idtarg <= 0)) then
713 call mpi_xermsg('Options_module', 'read_outer_interface', &
714 'IDTARG must be provided for all NTARG target states.', 1, 1)
715 end if
716 else if (option % write_amp .or. option % write_rmt) then
717 if (any(this % opts(:) % ci_target_switch == 0)) then
718 call mpi_xermsg('Options_module', 'read_outer_interface', &
719 'When NFTG = 0, outer interface requires setting NTARG and IDTARG.', 1, 1)
720 end if
721 end if
722
723 ! determine if this is a CI-contracted (scattering) run
724 is_scattering = any([(this % opts(n) % do_ci_contraction(), n = 1, size(this % opts))])
725
726 ! test availability of target (full molecular) properties
727 if (write_amp .or. write_rmt .or. (write_dip .and. is_scattering)) then
728 open (lutarg, status = 'old', action = 'read', form = 'formatted', iostat = io_stat, iomsg = io_msg)
729 if (io_stat /= 0) then
730 write (err_msg, '(a,i0,a)') 'Missing target properties (lutarg = ', lutarg, '):'//new_line(' ')//' * '//io_msg
731 call mpi_xermsg('Options_module', 'read_outer_interface', err_msg, 1, 1)
732 end if
733 close (lutarg)
734 end if
735
736 ! test availability target transition dipoles
737 if (write_rmt .or. (write_dip .and. is_scattering)) then
738 open (lutdip, status = 'old', action = 'read', form = 'formatted', iostat = io_stat, iomsg = io_msg)
739 if (io_stat /= 0) then
740 write (err_msg, '(a,i0,a)') 'Missing target dipoles (lutdip = ', lutdip, '):'//new_line(' ')//' * '//io_msg
741 call mpi_xermsg('Options_module', 'read_outer_interface', err_msg, 2, 1)
742 end if
743 close (lutdip)
744 end if
745
746 call move_alloc(this % interface_opts, options)
747 n = 0
748 if (allocated(options)) then
749 n = size(options)
750 end if
751 allocate (this % interface_opts(n + 1))
752
753 if (n > 0) then
754 this % interface_opts(1 : n) = options
755 end if
756 this % interface_opts(n + 1) = option
757
758 end do namelist_loop
759
760 end subroutine read_outer_interface
761
762
763 !> \brief Read and check input files
764 !> \authors A Al-Refaie
765 !> \date 2017
766 !>
767 subroutine read_input (this)
768 class(options), intent(inout) :: this
769
770 call this % read_congen
771
772 call this % compute_variables
773 call this % compute_expansions
774 call this % check_sanity_complete
775
776 call master_memory % construct(this % total_memory)
777 call master_memory % print_memory_report
778
779 end subroutine read_input
780
781
782 subroutine check_sanity_congen_header (this)
783 class(options), intent(inout) :: this
784
785 ! write(stdout,"(' ',A6,': ',A)") 'SCATCI',this%name
786 ! write(stdout,16) this%lambda,this%spin,this%num_electrons,this%spin_z,this%matrix_eval,this%refl_quanta,this%threshold,&
787 ! & this%num_syms,this%MEGUL,this%num_csfs,this%output_flag(1:6)
788 ! 16 FORMAT(' MGVN =',I10,5X,'S =',F5.1,/,' NELT =',I10,5X,'SZ =' &
789 ! & ,F5.1,/,' IDIAGT=',I10,5X,'R =',F5.1,/, &
790 ! & ' THRES=',D10.1,5X,'NSYM =',I5,/,' MEGUL=',I3,', NOCSF=' &
791 ! & ,I10,/,' NPFLG',I10,5I4)
792
793 if (this % num_csfs <= 0) THEN
794 write (stdout, "('Options::check_sanity_congen_header - No CSFS detected...stopping')")
795 stop 'No of CSFS = 0'
796 end if
797
798 end subroutine check_sanity_congen_header
799
800
801 !> \brief Print a subset of options read from the input
802 !> \authors A Al-Refaie
803 !> \date 2017
804 !>
805 !> Contrary to its name does not actually check anything.
806 !>
807 subroutine check_sanity_complete (this)
808 class(options), intent(inout) :: this
809
810 write (stdout, *)
811 write (stdout, "('---------------SCATCI run options------------------')")
812 write (stdout, "('Name of run is ', a)") trim(this % name)
813 write (stdout, "('CONGEN unit ', i4)") this % megul
814 write (stdout, "('Hamiltonian unit ', i4)") this % hamiltonian_unit
815 write (stdout, "('Number of hamiltonian records to write ', i4)") this % num_matrix_elements_per_rec
816 write (stdout, "('Integral unit ', i4)") this % integral_unit
817
818 write (stdout, "('Integral Type - ')", advance = 'no')
819 if (this % sym_group_flag <= 1) then
820 write (stdout, "('ALCHEMY')")
821 else if (this % sym_group_flag == 2 .and. this % use_UKRMOL_integrals) then
822 write (stdout, "('UKRMOL+')")
823 else
824 write (stdout, "('SWEDEN')")
825 end if
826
827 if (this%enh_factor_type .eq. 1) then
828 write(stdout,'(/,"Using an enhancement factor of ",f10.7)') this%enh_factor
829 elseif (this%enh_factor_type .eq. 2) then
830 this%enh_factor = 1.0
831 write(stdout,'(/,"Computing MP2 enhancement factor")')
832 elseif (this%enh_factor_type .eq. 3) then
833 write(stdout,'(/,"Computing enhanced MP2 enhancement factor using ",f10.7)')this%enh_factor
834 else
835 this%enh_factor = 1.0
836 endif
837
838 write (stdout, "('CI target Contraction? ')", advance = 'no')
839 if (this % ci_target_flag == no_ci_target) then
840 write (stdout, "('No')")
841 else
842 write (stdout, "('Yes')")
843 write (stdout, "('Generate CI vectors? ')", advance = 'no')
844 if (this % ci_target_switch == generate_target_wf) then
845 write (stdout, "('Yes')")
846 else
847 write (stdout, "('No, We are reading from unit ',i4)") this % ci_target_switch
848 end if
849 end if
850
851 write (stdout, "('Do we diagonalize? ')", advance = 'no')
852 if (this % diagonalization_flag == no_diagonalization) then
853 write (stdout, "('No')")
854 else if (this % diagonalization_flag == diagonalize) then
855 write (stdout, "('Yes with restart for ARPACK')")
856 else if (this % diagonalization_flag == diagonalize_no_restart) then
857 write (stdout, "('Yes with NO restart for ARPACK')")
858 endif
859
860 write (stdout, "('Num eigenpairs = ',i10)") this % num_eigenpairs
861 write (stdout, *)
862 write (stdout, "(' -----------Molecule options------------ ')")
863 write (stdout, "('Number of electrons = ', i10)") this % num_electrons
864 write (stdout, "('Number of molecular orbitals = ', i10)") this % tot_num_orbitals
865 write (stdout, "('Number of spin orbitals = ', i10)") this % tot_num_spin_orbitals
866 write (stdout, *)
867 write (stdout, "(' -----------CSF options------------ ')")
868 write (stdout, "('Number of configuration state functions = ', i10)") this % num_csfs
869 write (stdout, "('Number of continuum functions = ', i10)") this % last_continuum
870 this % num_L2_CSF = this % num_csfs - this % last_continuum
871 write (stdout, "('Number of L2 functions = ', i10)") this % num_L2_CSF
872 write (stdout, *)
873 write (stdout, "(' -----------Orbital/Symmetry options------------ ')")
874 write (stdout, "('Number of symmetries = ', i4)") this % num_syms
875 write (stdout, "('Number of orbitals per symmetry = ', 20i4)") this % num_orbitals_sym(:)
876 write (stdout, "('Number of electronic orbitals per symmetry = ', 20i4)") this % num_electronic_orbitals_sym(:)
877 write (stdout, "('Number of exotic orbitals per symmetry = ', 20i4)") this % num_positron_orbitals_sym(:)
878
879 write (stdout, "('Use ECP? ')", advance = 'no')
880 if (this % ecp_type == ecp_type_null) then
881 write (stdout, "('No')")
882 else
883 write (stdout, "('Yes')")
884 end if
885
886 end subroutine check_sanity_complete
887
888
889 !> \brief Reads all input information
890 !> \authors A Al-Refaie
891 !> \date 2017
892 !>
893 !> Reads saved setup from the congen output binary file.
894 !>
895 !> \todo Switch from old name list way into newer more robust input reading (use input.f90 like in TROVE?)
896 !>
897 subroutine read_congen (this)
898
899 class(options), intent(inout) :: this
900
901 !Dummy variables for RDNFTO
902 integer :: ido, nobep, ntgcon, idiagt
903 character(len=NAME_LEN_MAX) :: congen_name
904
905 !Begin reading first round of header information
906 rewind(this % megul)
907 read (this % megul) congen_name, this % lambda, this % spin, this % spin_z, this % refl_quanta, this % pin, &
908 this % tot_num_orbitals, this % tot_num_spin_orbitals, this % num_csfs, this % num_electrons, &
909 this % length_coeff,idiagt, this % num_syms, this % sym_group_flag, this % length_dtrs, &
910 this % output_flag, this % threshold, this % num_continuum, ntgcon
911
912 if (trim(this % name) == '') this % name = congen_name
913 if (this % matrix_eval < 0) this % matrix_eval = idiagt
914 if (ntgcon > 0) this % num_target_sym = ntgcon
915
916 call this % check_sanity_congen_header()
917
918 !allocate header arrays
919 call allocate_integer_array(this % num_orbitals_sym, this % num_syms)
920 call allocate_integer_array(this % num_electronic_orbitals_sym, this % num_syms)
921 call allocate_integer_array(this % num_positron_orbitals_sym, this % num_syms)
922 call allocate_integer_array(this % num_unused_orbitals_sym, this % num_syms)
923 call allocate_integer_array(this % reference_dtrs, this % num_electrons)
924 call allocate_integer_array(this % num_dtr_csf_out, this % num_csfs)
925 call allocate_integer_array(this % phase_index, this % num_continuum)
926 call allocate_integer_array(this % num_orbitals_sym_dinf, this % num_syms * 2)
927 call allocate_integer_array(this % num_target_orbitals_sym_congen, this % num_syms)
928 call allocate_integer_array(this % num_target_orbitals_sym, this % num_syms)
929 call allocate_integer_array(this % num_target_orbitals_sym_dinf_congen, this % num_syms * 2)
930 call allocate_integer_array(this % num_ci_target_sym, this % num_target_sym)
931 call allocate_integer_array(this % temp_orbs, this % num_target_sym)
932 call allocate_integer_array(this % num_continuum_orbitals_target, this % num_target_sym)
933 call allocate_integer_array(this % lambda_continuum_orbitals_target, this % num_target_sym)
934 call allocate_integer_array(this % gerade_sym_continuum_orbital_target, this % num_target_sym)
935 call allocate_integer_array(this % num_target_state_sym, this % num_target_sym)
936 call allocate_integer_array(this % orbital_sequence_number, this % num_csfs)
937
938 call rdnfto(this % megul, this % num_orbitals_sym, this % num_target_orbitals_sym_congen, this % num_orbitals_sym_dinf, &
939 this % num_target_orbitals_sym_dinf_congen, this % num_syms, this % reference_dtrs, this % num_electrons, &
940 this % num_dtr_csf_out, this % num_csfs, this % phase_index, this % num_continuum, this % num_ci_target_sym, &
941 this % temp_orbs, this % lambda_continuum_orbitals_target, this % gerade_sym_continuum_orbital_target, &
942 this % num_target_sym, this % num_target_sym, this % num_electronic_orbitals_sym, &
943 this % num_positron_orbitals_sym, this % num_unused_orbitals_sym, this % positron_flag , this % exchange_flag)
944
945 do ido = 1, this % num_syms
946 if (this % num_positron_orbitals_sym(ido) == 0) then
947 this % num_electronic_orbitals_sym(ido) = this % num_orbitals_sym(ido)
948 write (stdout, *) 'NOB(i)=', this % num_orbitals_sym(ido)
949 write (stdout, *) 'setting NOBE(i)=', this % num_electronic_orbitals_sym(ido)
950 end if
951 nobep = this % num_electronic_orbitals_sym(ido) + this % num_positron_orbitals_sym(ido)
952 if (nobep /= this % num_orbitals_sym(ido)) then
953 write (stdout, *) 'ERROR on input:'
954 write (stdout, *) 'not: NOB(i)=NOBE(i)+NOBP(i)'
955 write (stdout, *) 'i=', ido
956 write (stdout, *) 'NOB(i)=', this % num_orbitals_sym(ido)
957 write (stdout, *) 'NOBE(i)=', this % num_electronic_orbitals_sym(ido)
958 write (stdout, *) 'NOBP(i)=', this % num_positron_orbitals_sym(ido)
959 end if
960 if (this % num_unused_orbitals_sym(ido) == 0) then
961 this % num_unused_orbitals_sym(ido) = this % num_target_orbitals_sym_congen(ido)
962 end if
963 if (this % num_target_orbitals_sym_congen(ido) > this % num_orbitals_sym(ido)) then
964 write (stdout, *) 'ERROR on input:'
965 write (stdout, *) 'NOB0(i) > NOB(i)'
966 write (stdout, *) 'i=', ido
967 write (stdout, *) 'NOB(i)=', this % num_orbitals_sym(ido)
968 write (stdout, *) 'NOB0(i)=', this % num_target_orbitals_sym_congen(ido)
969 end if
970 end do
971
972 ! Allocate the phases for each target symmetry (must be allocated as it is used in main program)
973 allocate(this % ci_phase(this % num_target_sym))
974
975 ! Set up the phases
976 !call this % arrange_phase(this % phase_index)
977
978 end subroutine read_congen
979
980
981 subroutine arrange_phase (this, temp_phase)
982 class(options), intent(inout) :: this
983 integer, intent(in) :: temp_phase(:)
984 integer :: ido, ci_num
985
986 ci_num = 0
987
988 if (sum(this % num_ci_target_sym) == this % num_continuum) then
989 do ido = 1, this % num_target_sym
990 this % ci_phase(ido) % size_phaze = this % num_ci_target_sym(ido)
991 allocate(this % ci_phase(ido) % phase_index(this % ci_phase(ido) % size_phaze))
992 this % ci_phase(ido) % phase_index(1:this % ci_phase(ido) % size_phaze) = &
993 temp_phase(ci_num + 1 : ci_num + this % ci_phase(ido) % size_phaze)
994 ci_num = ci_num + this % ci_phase(ido) % size_phaze
995 end do
996 else if (this % num_continuum == 0) then
997 return
998 else
999 stop "[Options] Problem with phase not matching sum of NCTGT"
1000 end if
1001
1002 end subroutine arrange_phase
1003
1004
1005 !> \brief Set up write order flags
1006 !> \authors J Benda
1007 !> \date 2019
1008 !>
1009 !> To prevent mutual overwriting of the common output file, the MPI group masters, who write the eigenvectors to disk,
1010 !> need to communicate, so that the next set written by the next process commences only once the previous write is
1011 !> finished.
1012 !>
1013 subroutine setup_write_order (this)
1014
1015 class(optionsset), intent(inout) :: this
1016
1017 integer :: i, j, k, n
1018
1019 ! set up preceding/following relations for writing datasets in the same files
1020 do i = 1, size(this % opts)
1021
1022 n = 0 ! number of datasets written to the same file before this process
1023 k = 0 ! which setup index corresponds to the last write to the same file
1024
1025 do j = 1, i - 1
1026 if (this % opts(j) % CI_output_unit == this % opts(i) % CI_output_unit) then
1027 n = n + 1
1028 k = j
1029 end if
1030 end do
1031
1032 ! if automatic numbering of datasets is used, get the true unit number for this setup
1033 if (this % opts(i) % output_ci_set_number == 0) then
1034 this % opts(i) % output_ci_set_number = n + 1
1035 end if
1036
1037 ! if there is a previous dataset in the same file, link them to avoid lock/overwriting
1038 if (k > 0) then
1039 if (this % opts(i) % output_ci_set_number <= this % opts(k) % output_ci_set_number) then
1040 call mpi_xermsg('Options_module', 'read_all_namelists', &
1041 'The entries "nciset" must form ascending sequence.', i, 1)
1042 end if
1043 this % opts(k) % following_writer = grid % group_master_world_rank(grid % which_group_is_work(i))
1044 this % opts(i) % preceding_writer = grid % group_master_world_rank(grid % which_group_is_work(k))
1045 end if
1046
1047 end do
1048
1049 end subroutine setup_write_order
1050
1051
1052 !> \brief Computes additional variables required by scatci
1053 !> \authors A Al-Refaie
1054 !> \date 2017
1055 !>
1056 subroutine compute_variables (this)
1057 class(options), intent(inout) :: this
1058 integer :: itgtsym, isym, I, num_orb_temp
1059
1060 if (this % csf_type == prototype_csf) then
1061 this % num_target_orbitals_sym = 0
1062 do itgtsym = 1, this % num_target_sym
1063
1064 !If we're working with D_inf_h then we need to 'double' the symmtery
1065 if (this % sym_group_flag /= symtype_dinfh) then
1066 isym = this % lambda_continuum_orbitals_target(itgtsym) + 1
1067 else
1068 isym = (this % lambda_continuum_orbitals_target(itgtsym) * 2) + 1
1069 if (mod(this % lambda_continuum_orbitals_target(itgtsym), 2) == 0 .and. &
1070 this % gerade_sym_continuum_orbital_target(itgtsym) == -1) isym = isym + 1
1071 if (mod(this % lambda_continuum_orbitals_target(itgtsym), 2) == 1 .and. &
1072 this % gerade_sym_continuum_orbital_target(itgtsym) == 1) isym = isym + 1
1073 end if
1074
1075 !If there is already a value here then don't bother (impossible since the array must be allocated)
1076 if (this % num_target_orbitals_sym(isym) > 0) cycle
1077
1078 num_orb_temp = this % num_orbitals_sym(isym) - this % num_continuum_orbitals_target(itgtsym)
1079
1080 if (num_orb_temp < this % num_target_orbitals_sym_dinf_congen(isym)) then
1081 write (stdout, '(/,A)') 'Error: Incompatible number of target orbitals between CONGEN and SCATCI'
1082 write (stdout, '(7X,*(A,I0))') 'Target type ', itgtsym, ' with MGVN=', isym - 1
1083 write (stdout, '(7X,*(A,I0))') 'Total number of orbitals for MGVN=', isym - 1, ': ', &
1084 this % num_orbitals_sym(isym)
1085 write (stdout, '(7X,*(A,I0))') 'Number of continuum orbitals associated with target type: ', &
1086 this % num_continuum_orbitals_target(itgtsym)
1087 write (stdout, '(7X,*(A,I0))') 'Number of target orbitals for MGVN=', isym - 1, ' from CONGEN: ', &
1088 this % num_target_orbitals_sym_dinf_congen(isym)
1089
1090 call mpi_xermsg('Options_module', 'compute_variables', &
1091 'Incompatible number of target orbitals. Wrong CONGEN file or NOTGT?', itgtsym, 1)
1092 end if
1093
1094 this % num_target_orbitals_sym(isym) = num_orb_temp
1095
1096 end do
1097
1098 write (stdout, 1010) this % num_target_sym, (this % num_continuum_orbitals_target(i), i = 1, this % num_target_sym)
1099 1010 format(/,' Number of target symmetries in expansion, NTGSYM =',i5,/, &
1100 ' Number of continuum orbitals for each state, NOTGT =',20i5,/,(' ',20i5))
1101 write (stdout, 1020) (this % num_ci_target_sym(i), i = 1, this % num_target_sym)
1102 1020 format( ' Number of CI components for each state, NCTGT =',20i10,/,(' ',20i5))
1103 write (stdout, 1025) (this % num_target_state_sym(i), i = 1, this % num_target_sym)
1104 1025 format( ' Number of target states of each symmetry, NUMTGT =',20i5,/,(' ',20i5))
1105 write (stdout, 1030) (this % lambda_continuum_orbitals_target(i), i = 1, this % num_target_sym)
1106 1030 format( ' Continuum M projection for each state, MCONT =',20i5,/,(' ',20i5))
1107 if (this % gerade_sym_continuum_orbital_target(1) /= 0) then
1108 write (stdout, 1040) (this % gerade_sym_continuum_orbital_target(i), i = 1, this % num_target_sym)
1109 end if
1110 1040 format( ' Continuum G/U symmetry for each state, GUCONT =',20i5,/,(' ',20i5))
1111 write (stdout, *)
1112
1113 else if (this % num_continuum > 0) then
1114 this % num_continuum_orbitals_target(1:this%num_target_sym) = this % temp_orbs(1:this%num_target_sym)
1115 end if
1116
1117 this % all_ecp_defined = this % multiplicity_defined .and. this % spatial_defined
1118
1119 write (stdout, "(' NOBC =',I10,20I4)") (this % num_target_orbitals_sym(i), i = 1, this % num_syms)
1120 write (stdout, "(' NOB =',I10,20I4)") (this % num_orbitals_sym_dinf(i), i = 1, this % num_syms)
1121 write (stdout, "(' NOB0 =',I10,20I4)") (this % num_target_orbitals_sym_dinf_congen(i), i = 1 , this % num_syms)
1122
1123 end subroutine compute_variables
1124
1125
1126 subroutine compute_expansions (this)
1127 class(options), intent(inout) :: this
1128 integer :: lusme = 0
1129
1130 if (this % csf_type /= normal_csf .or. this % ci_target_flag /= no_ci_target) then
1131
1132 call mkpt(this % orbital_sequence_number, & ! kpt
1133 this % num_orbitals_sym_dinf, & ! nob
1134 this % num_target_orbitals_sym, & ! nobc
1135 this % sym_group_flag, & ! symtype
1136 this % num_continuum_orbitals_target, & ! notgt
1137 this % num_ci_target_sym, & ! nctgt
1138 this % lambda_continuum_orbitals_target, & ! mcont
1139 this % gerade_sym_continuum_orbital_target, & ! gucont
1140 this % contracted_mat_size, & ! mocsf
1141 this % num_csfs, & ! nocsf0
1142 this % actual_num_csfs, & ! mxcsf
1143 this % last_continuum, & ! ncont
1144 this % num_expanded_continuum_CSF, & ! ncont2
1145 this % num_target_sym, & ! ntgsym
1146 this % total_num_target_states, & ! ntgt
1147 this % num_target_state_sym, & ! numtgt
1148 this % total_num_ci_target, & ! ncitot
1149 this % maximum_num_target_states, & ! nummx
1150 this % csf_type, & ! iexpc
1151 this % ci_target_flag, & ! icitg
1152 lusme)
1153
1154 1050 format(' SCATCI will expand NOCSF =',i10,' prototype CSFs',/15x, &
1155 'into MXCSF =',i10,' actual configurations',/15x, &
1156 'and MOCSF =',i10,' dimension final Hamiltonian')
1157 write (stdout, 1050) this % num_csfs, this % actual_num_csfs, this % contracted_mat_size
1158
1159 else
1160
1161 this % contracted_mat_size = this % num_csfs
1162 this % actual_num_csfs = this % num_csfs
1163 this % total_num_target_states = this % num_target_sym
1164
1165 end if
1166
1167 write (stdout, "(/' Number of last continuum CSF, NCONT =',i7)") this % last_continuum
1168
1169 this % seq_num_last_continuum_csf = this % contracted_mat_size - (this % num_csfs - this % last_continuum)
1170 this % continuum_block_size = this % seq_num_last_continuum_csf
1171 if (this % num_eigenpairs == 0) this % num_eigenpairs = this % contracted_mat_size
1172
1173 end subroutine compute_expansions
1174
1175
1176 logical function do_ci_contraction (this)
1177 class(options), intent(inout) :: this
1178
1179 do_ci_contraction = (this % ci_target_flag == do_ci_target_contract)
1180
1181 end function do_ci_contraction
1182
1183
1184 subroutine allocate_integer_array (array, num_elms)
1185 integer, allocatable :: array(:)
1186 integer :: num_elms, err
1187
1188 if (.not. allocated(array)) then
1189 allocate(array(num_elms), stat = err)
1190 call master_memory % track_memory(storage_size(array)/8, size(array), err, 'OPTION::INT_ARRAY')
1191 if (err /= 0) then
1192 call mpi_xermsg('Options_module', 'allocate_integer_array', 'Error in allocating one of the arrays', 1, 1)
1193 end if
1194 array = 0
1195 end if
1196
1197 end subroutine allocate_integer_array
1198
1199
1200 subroutine allocate_real_array (array, num_elms)
1201 real(wp), allocatable :: array(:)
1202 integer :: num_elms, err
1203
1204 if (.not. allocated(array)) then
1205 allocate(array(num_elms), stat = err)
1206 call master_memory % track_memory(storage_size(array)/8, size(array), err, 'OPTION::REAL_ARRAY')
1207 if (err /= 0) then
1208 call mpi_xermsg('Options_module', 'allocate_real_array', 'Error in allocating one of the arrays', 1, 1)
1209 end if
1210 array = 0
1211 end if
1212
1213 end subroutine allocate_real_array
1214
1215
1216 !> \brief Read/write information about Hamiltonian
1217 !> \authors A Al-Refaie
1218 !> \date 2017
1219 !>
1220 !> Wrapper around SCATCI's ham_pars_io subroutine.
1221 !>
1222 !> Reads or writes the file 'ham_data' containing the parameters needed on the call to dgmain.
1223 !> If `write_ham_pars` is true, then the file is written interpretting the arguments as input.
1224 !> If `write_ham_pars` is false, then the file is read in interpretting the argumens as output.
1225 !>
1226 !> MPI-SCATCI uses only the writing mode, and only when the diagonalization is not undertaken.
1227 !>
1228 subroutine ham_pars_io_wrapper (option, write_ham_pars, nelms)
1229
1230 class(options), intent(inout) :: option
1231 logical, intent(in) :: write_ham_pars
1232 integer, intent(inout) :: nelms
1233 integer :: size_phase
1234
1235 size_phase = size(option % phase_index)
1236
1237 if (grid % grank /= master) return
1238
1239 call ham_pars_io(write_ham_pars, &
1240 option % seq_num_last_continuum_csf, &
1241 option % num_target_sym, &
1242 option % num_target_state_sym, &
1243 option % num_continuum_orbitals_target, &
1244 option % lambda_continuum_orbitals_target, &
1245 option % hamiltonian_unit, &
1246 nelms, &
1247 option % sym_group_flag, &
1248 option % spin, &
1249 option % spin_z, &
1250 option % num_electrons, &
1251 option % lambda, &
1252 option % integral_unit, &
1253 option % phase_index, &
1254 size_phase, &
1255 option % use_UKRMOL_integrals)
1256
1257 end subroutine ham_pars_io_wrapper
1258
1259end module options_module
consts_mpi_ci
MPI SCATCI Constants module.
Definition consts_mpi_ci.f90:31
consts_mpi_ci::normal_csf
integer, parameter normal_csf
Use configuration state functions as is.
Definition consts_mpi_ci.f90:70
consts_mpi_ci::scatci_decide
integer, parameter scatci_decide
SCATCI chooses the diagonalizer.
Definition consts_mpi_ci.f90:104
consts_mpi_ci::normal_phase
integer, parameter normal_phase
No phase correction.
Definition consts_mpi_ci.f90:98
consts_mpi_ci::diagonalize
integer, parameter diagonalize
Diagonalize.
Definition consts_mpi_ci.f90:90
consts_mpi_ci::do_ci_target_contract
integer, parameter do_ci_target_contract
Perform CI target contraction (target+scattering run)
Definition consts_mpi_ci.f90:66
consts_mpi_ci::symtype_dinfh
integer, parameter symtype_dinfh
This describes D_inf_h symmetries.
Definition consts_mpi_ci.f90:58
consts_mpi_ci::no_diagonalization
integer, parameter no_diagonalization
No diagonalization.
Definition consts_mpi_ci.f90:88
consts_mpi_ci::prototype_csf
integer, parameter prototype_csf
The configuration state functions are prototypes and therefore require expansion.
Definition consts_mpi_ci.f90:72
consts_mpi_ci::default_archer_memory
real(wp), parameter default_archer_memory
A default memory value (in GiB), we use the default given for per proc in archer.
Definition consts_mpi_ci.f90:49
consts_mpi_ci::name_len_max
integer, parameter name_len_max
The maximum length of a name.
Definition consts_mpi_ci.f90:52
consts_mpi_ci::ecp_type_null
integer, parameter ecp_type_null
Definition consts_mpi_ci.f90:150
consts_mpi_ci::diagonalize_no_restart
integer, parameter diagonalize_no_restart
Diagonalize but with no restart.
Definition consts_mpi_ci.f90:92
consts_mpi_ci::save_all_coeffs
integer, parameter save_all_coeffs
Do not discard any coefficients.
Definition consts_mpi_ci.f90:119
consts_mpi_ci::no_ci_target
integer, parameter no_ci_target
No Ci target contraction (target only run)
Definition consts_mpi_ci.f90:64
consts_mpi_ci::mxint
integer, parameter mxint
Maximal length of integer arrays in input namelists.
Definition consts_mpi_ci.f90:40
consts_mpi_ci::generate_target_wf
integer, parameter generate_target_wf
Generate target wavefunction parameter.
Definition consts_mpi_ci.f90:74