diff --git a/src/module_essential_input.F90 b/src/module_essential_input.F90 index 6e4b796b..7b8d2e4d 100644 --- a/src/module_essential_input.F90 +++ b/src/module_essential_input.F90 @@ -3,42 +3,53 @@ module module_essential_input use module_global_variables, only: rank implicit none private - public :: add_essential_input, update_esesential_input, & - check_all_essential_inputs_specified, & - get_essential_input_idx, essential_input_is_specified, & - essential_inputs, essential_input + public :: essential_inputs_container + type essential_input character(:), allocatable :: name logical :: is_specified end type essential_input - type(essential_input), allocatable :: essential_inputs(:) + + ! Use a derived type to encapsulate the essential inputs array + type essential_inputs_container + type(essential_input), allocatable :: inputs(:) + contains + procedure :: add_essential_input + procedure :: update_essential_input + procedure :: check_all_essential_inputs_specified + procedure :: get_essential_input_idx + procedure :: essential_input_is_specified + end type essential_inputs_container + contains - subroutine add_essential_input(name) + subroutine add_essential_input(this, name) implicit none + class(essential_inputs_container), intent(inout) :: this character(*), intent(in) :: name integer :: idx type(essential_input), allocatable :: tmp(:) - if (.not. allocated(essential_inputs)) then + if (.not. allocated(this%inputs)) then ! Allocate the first element idx = 1 - allocate (essential_inputs(idx)) + allocate (this%inputs(idx)) else ! Reallocate the array with new_size = current_size + 1 - idx = size(essential_inputs, 1) + 1 + idx = size(this%inputs, 1) + 1 allocate (tmp(idx)) - tmp(1:idx - 1) = essential_inputs - ! essential_inputs is reallocated with size = idx - call move_alloc(tmp, essential_inputs) + tmp(1:idx - 1) = this%inputs + ! this%inputs is reallocated with size = idx + call move_alloc(tmp, this%inputs) end if ! Add the name and default is_specified value - essential_inputs(idx)%name = trim(adjustl(name)) - essential_inputs(idx)%is_specified = .false. + this%inputs(idx)%name = trim(adjustl(name)) + this%inputs(idx)%is_specified = .false. end subroutine add_essential_input - subroutine update_esesential_input(name, is_specified) + subroutine update_essential_input(this, name, is_specified) implicit none + class(essential_inputs_container), intent(inout) :: this character(*), intent(in) :: name logical, intent(in) :: is_specified integer :: idx @@ -46,37 +57,39 @@ subroutine update_esesential_input(name, is_specified) ! Search the name in essential_inputs trimmed_name = trim(adjustl(name)) - do idx = 1, size(essential_inputs, 1) - if (essential_inputs(idx)%name == trimmed_name) then - essential_inputs(idx)%is_specified = is_specified + do idx = 1, size(this%inputs, 1) + if (this%inputs(idx)%name == trimmed_name) then + this%inputs(idx)%is_specified = is_specified return end if end do ! If the name is not found, it is an error. if (rank == 0) print *, "ERROR: Unknown input: ", trimmed_name call stop_with_errorcode(1) - end subroutine update_esesential_input + end subroutine update_essential_input - subroutine check_all_essential_inputs_specified() + subroutine check_all_essential_inputs_specified(this) implicit none + class(essential_inputs_container), intent(in) :: this integer :: idx - do idx = 1, size(essential_inputs, 1) - if (.not. essential_inputs(idx)%is_specified) then - if (rank == 0) print *, "ERROR: You must specify a variable '", trim(essential_inputs(idx)%name), "' before end." + do idx = 1, size(this%inputs, 1) + if (.not. this%inputs(idx)%is_specified) then + if (rank == 0) print *, "ERROR: You must specify a variable '", trim(this%inputs(idx)%name), "' before end." call stop_with_errorcode(1) end if end do end subroutine check_all_essential_inputs_specified - function get_essential_input_idx(name) result(idx) + function get_essential_input_idx(this, name) result(idx) implicit none + class(essential_inputs_container), intent(in) :: this character(*), intent(in) :: name integer :: i, idx character(:), allocatable :: trimmed_name trimmed_name = trim(adjustl(name)) - do i = 1, size(essential_inputs, 1) - if (essential_inputs(i)%name == trimmed_name) then + do i = 1, size(this%inputs, 1) + if (this%inputs(i)%name == trimmed_name) then idx = i return ! Found, return idx end if @@ -84,18 +97,19 @@ function get_essential_input_idx(name) result(idx) idx = -1 ! Not found end function get_essential_input_idx - function essential_input_is_specified(name) result(is_specified) + function essential_input_is_specified(this, name) result(is_specified) implicit none + class(essential_inputs_container), intent(in) :: this character(*), intent(in) :: name logical :: is_specified integer :: idx - idx = get_essential_input_idx(name) + idx = get_essential_input_idx(this, name) if (idx == -1) then if (rank == 0) print *, "ERROR: Unknown input: ", trim(adjustl(name)) call stop_with_errorcode(1) end if - is_specified = essential_inputs(idx)%is_specified + is_specified = this%inputs(idx)%is_specified end function essential_input_is_specified end module module_essential_input diff --git a/src/read_cidata.F90 b/src/read_cidata.F90 index 49cc8652..6c060c4e 100644 --- a/src/read_cidata.F90 +++ b/src/read_cidata.F90 @@ -15,19 +15,19 @@ subroutine read_cidata integer :: ninact_read, nact_read, nsec_read, nelec_read, nroot_read, totsym_read integer(kind=int64), allocatable :: dict_cas_idx_values(:) real(8), allocatable :: ecas(:) + type(essential_inputs_container) :: container - if (allocated(essential_inputs)) deallocate (essential_inputs) - call add_essential_input("ninact") - call add_essential_input("nact") - call add_essential_input("nsec") - call add_essential_input("nelec") - call add_essential_input("ndet") - call add_essential_input("nroot") - call add_essential_input("totsym") - call add_essential_input("ecas") - call add_essential_input("dict_cas_idx_values") - call add_essential_input("ci_coefficients") - call add_essential_input("end") + call container%add_essential_input("ninact") + call container%add_essential_input("nact") + call container%add_essential_input("nsec") + call container%add_essential_input("nelec") + call container%add_essential_input("ndet") + call container%add_essential_input("nroot") + call container%add_essential_input("totsym") + call container%add_essential_input("ecas") + call container%add_essential_input("dict_cas_idx_values") + call container%add_essential_input("ci_coefficients") + call container%add_essential_input("end") write (chr_totsym, *) totsym filename = "CIDATA_sym"//trim(adjustl(chr_totsym)) @@ -49,42 +49,42 @@ subroutine read_cidata if (rank == 0) print *, "Error: ninact in cidata file is not equal to ninact in input file." call stop_with_errorcode(1) end if - call update_esesential_input(trim(adjustl(key)), .true.) + call container%update_essential_input(trim(adjustl(key)), .true.) case ("nact") read (unit) nact_read if (nact_read /= nact) then if (rank == 0) print *, "Error: nact in cidata file is not equal to nact in input file." call stop_with_errorcode(1) end if - call update_esesential_input(trim(adjustl(key)), .true.) + call container%update_essential_input(trim(adjustl(key)), .true.) case ("nsec") read (unit) nsec_read if (nsec_read /= nsec) then if (rank == 0) print *, "Error: nsec in cidata file is not equal to nsec in input file." call stop_with_errorcode(1) end if - call update_esesential_input(trim(adjustl(key)), .true.) + call container%update_essential_input(trim(adjustl(key)), .true.) case ("nelec") read (unit) nelec_read if (nelec_read /= nelec) then if (rank == 0) print *, "Error: nelec in cidata file is not equal to nelec in input file." call stop_with_errorcode(1) end if - call update_esesential_input(trim(adjustl(key)), .true.) + call container%update_essential_input(trim(adjustl(key)), .true.) case ("ndet") read (unit) ndet if (ndet < 0) then if (rank == 0) print *, "Error: Invalid ndet in cidata file. ndet = ", ndet call stop_with_errorcode(1) end if - call update_esesential_input(trim(adjustl(key)), .true.) + call container%update_essential_input(trim(adjustl(key)), .true.) case ("nroot") read (unit) nroot_read if (nroot_read < 0) then if (rank == 0) print *, "Error: Invalid nroot in cidata file. nroot = ", nroot_read call stop_with_errorcode(1) end if - call update_esesential_input(trim(adjustl(key)), .true.) + call container%update_essential_input(trim(adjustl(key)), .true.) case ("totsym") read (unit) totsym_read if (totsym_read /= totsym) then @@ -92,9 +92,9 @@ subroutine read_cidata " totsym = ", totsym call stop_with_errorcode(1) end if - call update_esesential_input(trim(adjustl(key)), .true.) + call container%update_essential_input(trim(adjustl(key)), .true.) case ("ecas") - if (.not. essential_input_is_specified("nroot")) then + if (.not. container%essential_input_is_specified("nroot")) then if (rank == 0) print *, "Error: ecas detected before nroot." call stop_with_errorcode(1) end if @@ -104,9 +104,9 @@ subroutine read_cidata read (unit) ecas eigen(:) = ecas(1:nroot_read) + ecore deallocate (ecas) - call update_esesential_input(trim(adjustl(key)), .true.) + call container%update_essential_input(trim(adjustl(key)), .true.) case ("dict_cas_idx_values") - if (.not. essential_input_is_specified("ndet")) then + if (.not. container%essential_input_is_specified("ndet")) then if (rank == 0) print *, "Error: dict_cas_idx_values detected before ndet." call stop_with_errorcode(1) end if @@ -119,13 +119,13 @@ subroutine read_cidata call add(dict_cas_idx_reverse, dict_cas_idx_values(i), int(i, kind=int64)) end do deallocate (dict_cas_idx_values) - call update_esesential_input(trim(adjustl(key)), .true.) + call container%update_essential_input(trim(adjustl(key)), .true.) case ("ci_coefficients") - if (.not. essential_input_is_specified("ndet")) then + if (.not. container%essential_input_is_specified("ndet")) then if (rank == 0) print *, "Error: ci_coefficients detected before ndet." call stop_with_errorcode(1) end if - if (.not. essential_input_is_specified("nroot")) then + if (.not. container%essential_input_is_specified("nroot")) then if (rank == 0) print *, "Error: ci_coefficients detected before nroot." call stop_with_errorcode(1) end if @@ -138,9 +138,9 @@ subroutine read_cidata read (unit) cir read (unit) cii end if - call update_esesential_input(trim(adjustl(key)), .true.) + call container%update_essential_input(trim(adjustl(key)), .true.) case ("end") - call update_esesential_input(trim(adjustl(key)), .true.) + call container%update_essential_input(trim(adjustl(key)), .true.) exit case default if (rank == 0) print *, "Error: Unknown keyword in cidata file." @@ -148,8 +148,7 @@ subroutine read_cidata end select end do - call check_all_essential_inputs_specified - deallocate (essential_inputs) + call container%check_all_essential_inputs_specified() close (unit) end subroutine read_cidata diff --git a/src/read_input_module.F90 b/src/read_input_module.F90 index 766dbd55..91365506 100644 --- a/src/read_input_module.F90 +++ b/src/read_input_module.F90 @@ -6,8 +6,7 @@ module read_input_module ! ! This is a utility module that interpret and parse input strings. !=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=!=! - use module_essential_input, only: add_essential_input, update_esesential_input, & - check_all_essential_inputs_specified, essential_inputs + use module_essential_input use module_global_variables, only: rank, len_convert_int_to_chr use module_error, only: stop_with_errorcode implicit none @@ -15,16 +14,17 @@ module read_input_module public read_input, check_substring, ras_read, lowercase, uppercase logical is_end, set_caspt2_ciroots integer, parameter :: input_intmax = 10**9, max_str_length = 500 + type(essential_inputs_container) :: container contains subroutine init_essential_variables - call add_essential_input(".ninact") - call add_essential_input(".nact") - call add_essential_input(".nsec") - call add_essential_input(".nelec") - call add_essential_input(".diracver") - call add_essential_input(".subprograms") + call container%add_essential_input(".ninact") + call container%add_essential_input(".nact") + call container%add_essential_input(".nsec") + call container%add_essential_input(".nelec") + call container%add_essential_input(".diracver") + call container%add_essential_input(".subprograms") end subroutine init_essential_variables subroutine print_input_file(unit_num) @@ -86,7 +86,7 @@ subroutine read_input(unit_num, bypass_reqired_file_check) call read_keyword_and_value(unit_num, string) end do - call check_all_essential_inputs_specified + call container%check_all_essential_inputs_specified() call set_global_index call set_mdcint_scheme call check_ciroots_set @@ -112,19 +112,19 @@ subroutine read_keyword_and_value(unit_num, string) case (".ninact") call read_an_integer(unit_num, ".ninact", 0, input_intmax, ninact) - call update_esesential_input(".ninact", .true.) + call container%update_essential_input(".ninact", .true.) case (".nact") call read_an_integer(unit_num, ".nact", 0, input_intmax, nact) - call update_esesential_input(".nact", .true.) + call container%update_essential_input(".nact", .true.) case (".nsec") call read_an_integer(unit_num, ".nsec", 0, input_intmax, nsec) - call update_esesential_input(".nsec", .true.) + call container%update_essential_input(".nsec", .true.) case (".nelec") call read_an_integer(unit_num, ".nelec", 0, input_intmax, nelec) - call update_esesential_input(".nelec", .true.) + call container%update_essential_input(".nelec", .true.) case (".caspt2_ciroots") call read_caspt2_ciroots(unit_num) @@ -145,7 +145,7 @@ subroutine read_keyword_and_value(unit_num, string) case (".diracver") call read_an_integer(unit_num, ".diracver", 0, input_intmax, dirac_version) - call update_esesential_input(".diracver", .true.) + call container%update_essential_input(".diracver", .true.) case (".nhomo") call read_an_integer(unit_num, ".nhomo", 0, input_intmax, nhomo) @@ -209,7 +209,7 @@ subroutine read_keyword_and_value(unit_num, string) case (".subprograms") call read_subprograms(unit_num) - call update_esesential_input(".subprograms", .true.) + call container%update_essential_input(".subprograms", .true.) case (".countndet") docountndet = .true. @@ -217,7 +217,7 @@ subroutine read_keyword_and_value(unit_num, string) ! but if .countndet is specified, the other subroutines will be skipped. ! Therefore, if .countndet is specified, .subprograms doesn't need to be specified. ! Thus, we set essential input "subprograms" to .true. - call update_esesential_input(".subprograms", .true.) + call container%update_essential_input(".subprograms", .true.) case (".end") is_end = .true.