| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| integer, | intent(in) | :: | iunit | |||
| integer, | intent(in) | :: | n_el | |||
| integer, | intent(in) | :: | n_spat_orb | |||
| real(kind=dp), | intent(in) | :: | sparse | |||
| real(kind=dp), | intent(in) | :: | sparseT | |||
| type(SpinProj_t), | intent(in) | :: | total_ms | |||
| logical, | intent(in), | optional | :: | uhf |
specify if the FCIDUMP is UHF specify if the FCIDUMP is hermitian Note if uhf then assume num spin-up basis functions = num spin-down basis functions |
|
| logical, | intent(in), | optional | :: | hermitian |
specify if the FCIDUMP is UHF specify if the FCIDUMP is hermitian Note if uhf then assume num spin-up basis functions = num spin-down basis functions |
subroutine generate_random_integrals(iunit, n_el, n_spat_orb, sparse, sparseT, & total_ms, uhf, hermitian) integer, intent(in) :: iunit, n_el, n_spat_orb real(dp), intent(in) :: sparse, sparseT type(SpinProj_t), intent(in) :: total_ms logical, optional, intent(in) :: uhf, hermitian !! specify if the FCIDUMP is UHF !! specify if the FCIDUMP is hermitian !! !! @note if uhf then assume !! num spin-up basis functions = num spin-down basis functions logical :: uhf_, hermitian_ integer :: i, j, k, l, j_end, l_end real(dp) :: r, matel ! we get random matrix elements from the cauchy-schwartz inequalities, so ! only <ij|ij> are random -> random 2d matrix real(dp), allocatable :: umatRand(:, :) integer :: norb ! n_spin_orb or n_spat_orb def_default(hermitian_, hermitian, .true.) ! UHF FCIDUMPs have six sectors: ! two-body integrals: up-up, down-down, up-down ! one-body integrals: up, down ! nuclear repulsion ! delimiter: 0.0000000000000000E+00 0 0 0 0 def_default(uhf_, uhf, .false.) norb = merge(2*n_spat_orb, n_spat_orb, uhf_) allocate(umatRand(norb, norb), source=0.0_dp) do i = 1, norb do j = 1, norb r = genrand_real2_dSFMT() if (r < sparse) then umatRand(i, j) = r * r if (hermitian_) then umatRand(j, i) = umatRand(i, j) else ! have the conjugate be similar umatRand(j, i) = (1 + genrand_real2_dSFMT() * 0.1) * umatRand(i, j) endif end if end do end do ! write the canonical FCIDUMP header (norb here is num spatial orbitals) write(iunit, *) "&FCI NORB=", n_spat_orb, ",NELEC=", n_el, "MS2=", total_ms%val, "," write(iunit, "(A)", advance="no") "ORBSYM=" do i = 1, n_spat_orb write(iunit, "(A)", advance="no") "1," end do write(iunit, *) write(iunit, *) "ISYM=1," write(iunit, *) "&END" ! generate random 4-index integrals with a given sparsity ! then ! generate random 2-index integrals with a given sparsity if(uhf_) then ! three 4-index sectors, so three calls to write_4index call write_4index(1, n_spat_orb, 1, n_spat_orb, hermitian_) write(iunit, *) 0.0000000000000000E+00, 0, 0, 0, 0 ! delimiter ! we can keep using the spatial orbitals as indices because of the ! partitioning of the dump file call write_4index(1, n_spat_orb, 1, n_spat_orb, hermitian_) write(iunit, *) 0.0000000000000000E+00, 0, 0, 0, 0 call write_4index(1, n_spat_orb, 1, n_spat_orb, hermitian_) write(iunit, *) 0.0000000000000000E+00, 0, 0, 0, 0 call write_2index(1, n_spat_orb, hermitian_) write(iunit, *) 0.0000000000000000E+00, 0, 0, 0, 0 call write_2index(1, n_spat_orb, hermitian_) write(iunit, *) 0.0000000000000000E+00, 0, 0, 0, 0 ! then would come the nuclear repulsion else ! .not. uhf_ call write_4index(1, norb, 1, norb, hermitian_) call write_2index(1, n_spat_orb, hermitian_) endif contains subroutine write_4index(i_start, i_end, k_start, k_end, hermitian) ! i_end corresponds to electron 1, j_end to electron 2 integer, intent(in) :: i_start, i_end, k_start, k_end logical, intent(in) :: hermitian integer :: k_start_ do i = i_start, i_end ! j_end = i if hermitian, else i_end j_end = merge(i, i_end, hermitian) do j = 1, j_end ! if the Hamiltonian *is* Hermitian, we may flip these indices k_start_ = merge(i, k_start, hermitian) do k = k_start_, k_end l_end = merge(k, k_end, hermitian) do l = 1, l_end matel = sqrt(umatRand(i, j) * umatRand(k, l)) if (matel > eps) write(iunit, *) matel, i, j, k, l end do end do end do end do end subroutine write_4index subroutine write_2index(i_start, i_end, hermitian) integer, intent(in) :: i_start, i_end logical, intent(in) :: hermitian do i = i_start, i_end j_end = merge(i, i_end, hermitian) do j = i_start, j_end r = genrand_real2_dSFMT() if (r < sparseT) then write(iunit, *) r, i, j, 0, 0 end if end do end do end subroutine write_2index end subroutine generate_random_integrals