126#include "./base/base_uses.f90"
131 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'negf_methods'
132 LOGICAL,
PARAMETER,
PRIVATE :: debug_this_module = .true.
141 TYPE integration_status_type
142 INTEGER :: npoints = -1
143 REAL(kind=
dp) :: error = -1.0_dp
144 END TYPE integration_status_type
158 CHARACTER(LEN=*),
PARAMETER :: routinen =
'do_negf'
160 CHARACTER(len=default_string_length) :: contact_id_str, filename
161 INTEGER :: handle, icontact, ispin, log_unit, &
162 ncontacts, npoints, nspins, &
163 print_level, print_unit
164 LOGICAL :: debug_output, exist, should_output, &
166 REAL(kind=
dp) :: energy_max, energy_min
167 REAL(kind=
dp),
DIMENSION(2) :: current
180 negf_mixing_section, negf_section, &
181 print_section, root_section
183 CALL timeset(routinen, handle)
190 NULLIFY (blacs_env, cp_subsys, global_env, qs_env, root_section, sub_force_env)
191 CALL force_env_get(force_env, globenv=global_env, qs_env=qs_env, root_section=root_section, &
192 sub_force_env=sub_force_env, subsys=cp_subsys)
194 CALL get_qs_env(qs_env, blacs_env=blacs_env, para_env=para_env_global)
200 NULLIFY (negf_control)
203 CALL get_qs_env(qs_env, dft_control=dft_control)
206 log_unit =
cp_print_key_unit_nr(logger, negf_section,
"PRINT%PROGRAM_RUN_INFO", extension=
".Log")
208 IF (log_unit > 0)
THEN
209 WRITE (log_unit,
'(/,T2,79("-"))')
210 WRITE (log_unit,
'(T27,A,T62)')
"NEGF calculation is started"
211 WRITE (log_unit,
'(T2,79("-"))')
216 CALL section_vals_val_get(negf_section,
"PRINT%PROGRAM_RUN_INFO%PRINT_LEVEL", i_val=print_level)
217 SELECT CASE (print_level)
219 verbose_output = .true.
221 verbose_output = .true.
222 debug_output = .true.
224 verbose_output = .false.
225 debug_output = .false.
228 IF (log_unit > 0)
THEN
229 WRITE (log_unit,
"(/,' THE RELEVANT HAMILTONIAN AND OVERLAP MATRICES FROM DFT')")
230 WRITE (log_unit,
"( ' ------------------------------------------------------')")
233 CALL negf_sub_env_create(sub_env, negf_control, blacs_env, global_env%blacs_grid_layout, global_env%blacs_repeatable)
234 CALL negf_env_create(negf_env, sub_env, negf_control, force_env, negf_mixing_section, log_unit)
236 filename = trim(logger%iter_info%project_name)//
'-negf.restart'
237 INQUIRE (file=filename, exist=exist)
238 IF (exist)
CALL negf_read_restart(filename, negf_env, negf_control)
240 IF (log_unit > 0)
THEN
241 WRITE (log_unit,
"(/,' NEGF| The initial Hamiltonian and Overlap matrices are calculated.')")
244 CALL negf_output_initial(log_unit, negf_env, sub_env, negf_control, dft_control, verbose_output, debug_output)
251 ncontacts =
SIZE(negf_control%contacts)
252 DO icontact = 1, ncontacts
254 IF (negf_control%contacts(icontact)%force_env_index > 0)
THEN
255 CALL force_env_get(sub_force_env(negf_control%contacts(icontact)%force_env_index)%force_env, qs_env=qs_env)
260 CALL guess_fermi_level(icontact, negf_env, negf_control, sub_env, qs_env, log_unit)
265 IF (should_output)
THEN
273 middle_name=trim(adjustl(contact_id_str)), &
274 file_status=
"REPLACE")
275 CALL negf_print_dos(print_unit, energy_min, energy_max, npoints, &
276 v_shift=0.0_dp, negf_env=negf_env, negf_control=negf_control, &
277 sub_env=sub_env, base_contact=icontact, just_contact=icontact)
285 IF (ncontacts > 1)
THEN
290 CALL shift_potential(negf_env, negf_control, sub_env, qs_env, base_contact=1, log_unit=log_unit)
294 CALL converge_density(negf_env, negf_control, sub_env, qs_env, negf_control%v_shift, base_contact=1, log_unit=log_unit)
299 IF (para_env_global%is_source() .AND. negf_control%write_common_restart_file) &
300 CALL negf_write_restart(filename, negf_env, negf_control)
304 CALL get_qs_env(qs_env, dft_control=dft_control)
306 nspins = dft_control%nspins
308 cpassert(nspins <= 2)
314 current(ispin) = negf_compute_current(contact_id1=1, contact_id2=2, &
315 v_shift=negf_control%v_shift, &
317 negf_control=negf_control, &
320 blacs_env_global=blacs_env)
323 IF (log_unit > 0)
THEN
325 WRITE (log_unit,
'(/,T2,A,T60,ES20.7E2)')
"NEGF| Alpha-spin electric current (A)", current(1)
326 WRITE (log_unit,
'(T2,A,T60,ES20.7E2)')
"NEGF| Beta-spin electric current (A)", current(2)
328 WRITE (log_unit,
'(/,T2,A,T60,ES20.7E2)')
"NEGF| Electric current (A)", 2.0_dp*current(1)
337 IF (should_output)
THEN
345 middle_name=trim(adjustl(contact_id_str)), &
346 file_status=
"REPLACE")
348 CALL negf_print_dos(print_unit, energy_min, energy_max, npoints, negf_control%v_shift, &
349 negf_env=negf_env, negf_control=negf_control, &
350 sub_env=sub_env, base_contact=1)
359 IF (should_output)
THEN
366 extension=
".transm", &
367 middle_name=trim(adjustl(contact_id_str)), &
368 file_status=
"REPLACE")
370 CALL negf_print_transmission(print_unit, energy_min, energy_max, npoints, negf_control%v_shift, &
371 negf_env=negf_env, negf_control=negf_control, &
372 sub_env=sub_env, contact_id1=1, contact_id2=2)
379 IF (log_unit > 0)
THEN
380 WRITE (log_unit,
'(/,T2,79("-"))')
381 WRITE (log_unit,
'(T27,A,T62)')
"NEGF calculation is finished"
382 WRITE (log_unit,
'(T2,79("-"))')
388 CALL timestop(handle)
403 SUBROUTINE guess_fermi_level(contact_id, negf_env, negf_control, sub_env, qs_env, log_unit)
404 INTEGER,
INTENT(in) :: contact_id
409 INTEGER,
INTENT(in) :: log_unit
411 CHARACTER(LEN=*),
PARAMETER :: routinen =
'guess_fermi_level'
414 CHARACTER(len=default_string_length) :: temperature_str
415 COMPLEX(kind=dp) :: lbound_cpath, lbound_lpath, ubound_lpath
416 INTEGER :: direction_axis_abs, handle, image, &
417 ispin, nao, nimages, nspins, step
418 INTEGER,
ALLOCATABLE,
DIMENSION(:, :) :: index_to_cell
419 INTEGER,
DIMENSION(:, :, :),
POINTER :: cell_to_index
420 LOGICAL :: do_kpoints
421 REAL(kind=
dp) :: delta_au, delta_ef, energy_ubound_minus_fermi, fermi_level_guess, &
422 fermi_level_max, fermi_level_min, nelectrons_guess, nelectrons_max, nelectrons_min, &
423 nelectrons_qs_cell0, nelectrons_qs_cell1, offset_au, rscale, t1, t2, trace
428 TYPE(
dbcsr_p_type),
DIMENSION(:, :),
POINTER :: matrix_s_kp, rho_ao_qs_kp
431 TYPE(integration_status_type) :: stats
438 CALL timeset(routinen, handle)
440 IF (log_unit > 0)
THEN
441 WRITE (temperature_str,
'(F11.3)') negf_control%contacts(contact_id)%temperature*
kelvin
442 WRITE (log_unit,
'(/,T2,A,I3)')
"FERMI LEVEL OF CONTACT ", contact_id
443 WRITE (log_unit,
"( ' --------------------------')")
444 WRITE (log_unit,
'(A)')
" Temperature "//trim(adjustl(temperature_str))//
" Kelvin"
447 IF (.NOT. negf_control%contacts(contact_id)%is_restart)
THEN
450 blacs_env=blacs_env_global, &
451 dft_control=dft_control, &
452 do_kpoints=do_kpoints, &
454 matrix_s_kp=matrix_s_kp, &
455 para_env=para_env_global, &
456 rho=rho_struct, subsys=subsys)
457 CALL qs_rho_get(rho_struct, rho_ao_kp=rho_ao_qs_kp)
459 nimages = dft_control%nimages
460 nspins = dft_control%nspins
461 direction_axis_abs = abs(negf_env%contacts(contact_id)%direction_axis)
463 cpassert(
SIZE(negf_env%contacts(contact_id)%h_00) == nspins)
465 IF (sub_env%ngroups > 1)
THEN
466 NULLIFY (matrix_s_fm, fm_struct)
468 CALL cp_fm_get_info(negf_env%contacts(contact_id)%s_00, nrow_global=nao)
469 CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nao, context=blacs_env_global)
472 ALLOCATE (matrix_s_fm)
476 IF (sub_env%group_distribution(sub_env%mepos_global) == 0)
THEN
477 CALL cp_fm_copy_general(negf_env%contacts(contact_id)%s_00, matrix_s_fm, para_env_global)
482 matrix_s_fm => negf_env%contacts(contact_id)%s_00
490 ALLOCATE (cell_to_index(0:0, 0:0, 0:0))
491 cell_to_index(0, 0, 0) = 1
494 ALLOCATE (index_to_cell(3, nimages))
496 IF (.NOT. do_kpoints)
DEALLOCATE (cell_to_index)
498 IF (nspins == 1)
THEN
506 nelectrons_qs_cell0 = 0.0_dp
507 nelectrons_qs_cell1 = 0.0_dp
508 IF (negf_control%contacts(contact_id)%force_env_index > 0)
THEN
509 DO image = 1, nimages
510 IF (index_to_cell(direction_axis_abs, image) == 0)
THEN
512 CALL dbcsr_dot(rho_ao_qs_kp(ispin, image)%matrix, matrix_s_kp(1, image)%matrix, trace)
513 nelectrons_qs_cell0 = nelectrons_qs_cell0 + trace
515 ELSE IF (abs(index_to_cell(direction_axis_abs, image)) == 1)
THEN
517 CALL dbcsr_dot(rho_ao_qs_kp(ispin, image)%matrix, matrix_s_kp(1, image)%matrix, trace)
518 nelectrons_qs_cell1 = nelectrons_qs_cell1 + trace
522 negf_env%contacts(contact_id)%nelectrons_qs_cell0 = nelectrons_qs_cell0
523 negf_env%contacts(contact_id)%nelectrons_qs_cell1 = nelectrons_qs_cell1
524 ELSE IF (negf_control%contacts(contact_id)%force_env_index <= 0)
THEN
526 CALL cp_fm_trace(negf_env%contacts(contact_id)%rho_00(ispin), &
527 negf_env%contacts(contact_id)%s_00, trace)
528 nelectrons_qs_cell0 = nelectrons_qs_cell0 + trace
529 CALL cp_fm_trace(negf_env%contacts(contact_id)%rho_01(ispin), &
530 negf_env%contacts(contact_id)%s_01, trace)
531 nelectrons_qs_cell1 = nelectrons_qs_cell1 + 2.0_dp*trace
533 negf_env%contacts(contact_id)%nelectrons_qs_cell0 = nelectrons_qs_cell0
534 negf_env%contacts(contact_id)%nelectrons_qs_cell1 = nelectrons_qs_cell1
537 DEALLOCATE (index_to_cell)
539 IF (sub_env%ngroups > 1)
THEN
541 DEALLOCATE (matrix_s_fm)
547 nelectrons_qs_cell0 = negf_env%contacts(contact_id)%nelectrons_qs_cell0
548 nelectrons_qs_cell1 = negf_env%contacts(contact_id)%nelectrons_qs_cell1
552 IF (negf_control%contacts(contact_id)%compute_fermi_level)
THEN
555 blacs_env=blacs_env_global, &
556 dft_control=dft_control, &
557 do_kpoints=do_kpoints, &
559 matrix_s_kp=matrix_s_kp, &
560 para_env=para_env_global, &
561 rho=rho_struct, subsys=subsys)
562 CALL qs_rho_get(rho_struct, rho_ao_kp=rho_ao_qs_kp)
564 nimages = dft_control%nimages
565 nspins = dft_control%nspins
566 direction_axis_abs = abs(negf_env%contacts(contact_id)%direction_axis)
567 IF (nspins == 1)
THEN
574 cpassert(
SIZE(negf_env%contacts(contact_id)%h_00) == nspins)
576 IF (sub_env%ngroups > 1)
THEN
577 NULLIFY (matrix_s_fm, fm_struct)
579 CALL cp_fm_get_info(negf_env%contacts(contact_id)%s_00, nrow_global=nao)
580 CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nao, context=blacs_env_global)
583 ALLOCATE (matrix_s_fm)
587 IF (sub_env%group_distribution(sub_env%mepos_global) == 0)
THEN
588 CALL cp_fm_copy_general(negf_env%contacts(contact_id)%s_00, matrix_s_fm, para_env_global)
593 matrix_s_fm => negf_env%contacts(contact_id)%s_00
598 IF (log_unit > 0)
THEN
599 WRITE (log_unit,
'(A)')
" Computing the Fermi level of bulk electrode"
600 WRITE (log_unit,
'(T2,A,T60,F20.10,/)')
"Electronic density of the electrode unit cell:", &
601 -1.0_dp*(nelectrons_qs_cell0 + nelectrons_qs_cell1)
602 WRITE (log_unit,
'(T3,A)')
"Step Integration method Time Fermi level Convergence (density)"
603 WRITE (log_unit,
'(T3,78("-"))')
609 negf_env%contacts(contact_id)%fermi_energy = energy%efermi
610 IF (negf_control%homo_lumo_gap > 0.0_dp)
THEN
611 IF (negf_control%contacts(contact_id)%refine_fermi_level)
THEN
612 fermi_level_min = negf_control%contacts(contact_id)%fermi_level
614 fermi_level_min = energy%efermi
616 fermi_level_max = fermi_level_min + negf_control%homo_lumo_gap
618 IF (negf_control%contacts(contact_id)%refine_fermi_level)
THEN
619 fermi_level_max = negf_control%contacts(contact_id)%fermi_level
621 fermi_level_max = energy%efermi
623 fermi_level_min = fermi_level_max + negf_control%homo_lumo_gap
627 lbound_cpath = cmplx(negf_control%energy_lbound, negf_control%eta, kind=
dp)
628 delta_au = real(negf_control%delta_npoles, kind=
dp)*
twopi*negf_control%contacts(contact_id)%temperature
629 offset_au = real(negf_control%gamma_kT, kind=
dp)*negf_control%contacts(contact_id)%temperature
630 energy_ubound_minus_fermi = -2.0_dp*log(negf_control%conv_density)*negf_control%contacts(contact_id)%temperature
638 fermi_level_guess = fermi_level_min
640 fermi_level_guess = fermi_level_max
642 fermi_level_guess = fermi_level_min - (nelectrons_min - nelectrons_qs_cell0)* &
643 (fermi_level_max - fermi_level_min)/(nelectrons_max - nelectrons_min)
646 negf_control%contacts(contact_id)%fermi_level = fermi_level_guess
647 nelectrons_guess = 0.0_dp
649 lbound_lpath = cmplx(fermi_level_guess - offset_au, delta_au, kind=
dp)
650 ubound_lpath = cmplx(fermi_level_guess + energy_ubound_minus_fermi, delta_au, kind=
dp)
652 CALL integration_status_reset(stats)
655 CALL negf_init_rho_equiv_residuals(rho_ao_fm=rho_ao_fm, &
657 ignore_bias=.true., &
659 negf_control=negf_control, &
662 base_contact=contact_id, &
663 just_contact=contact_id)
665 CALL negf_add_rho_equiv_low(rho_ao_fm=rho_ao_fm, &
668 ignore_bias=.true., &
670 negf_control=negf_control, &
673 base_contact=contact_id, &
674 integr_lbound=lbound_cpath, &
675 integr_ubound=lbound_lpath, &
676 matrix_s_global=matrix_s_fm, &
677 is_circular=.true., &
678 g_surf_cache=g_surf_cache, &
679 just_contact=contact_id)
682 CALL negf_add_rho_equiv_low(rho_ao_fm=rho_ao_fm, &
685 ignore_bias=.true., &
687 negf_control=negf_control, &
690 base_contact=contact_id, &
691 integr_lbound=lbound_lpath, &
692 integr_ubound=ubound_lpath, &
693 matrix_s_global=matrix_s_fm, &
694 is_circular=.false., &
695 g_surf_cache=g_surf_cache, &
696 just_contact=contact_id)
700 nelectrons_guess = nelectrons_guess + trace
703 nelectrons_guess = nelectrons_guess*rscale
707 IF (log_unit > 0)
THEN
708 WRITE (log_unit,
'(T2,I5,T12,A,T32,F8.1,T42,F15.8,T60,ES20.5E2)') &
709 step, get_method_description_string(stats, negf_control%integr_method), &
710 t2 - t1, fermi_level_guess, nelectrons_guess - nelectrons_qs_cell0
713 IF (abs(nelectrons_qs_cell0 - nelectrons_guess) < negf_control%conv_density)
EXIT
717 nelectrons_min = nelectrons_guess
719 nelectrons_max = nelectrons_guess
721 IF (fermi_level_guess < fermi_level_min)
THEN
722 fermi_level_max = fermi_level_min
723 nelectrons_max = nelectrons_min
724 fermi_level_min = fermi_level_guess
725 nelectrons_min = nelectrons_guess
726 ELSE IF (fermi_level_guess > fermi_level_max)
THEN
727 fermi_level_min = fermi_level_max
728 nelectrons_min = nelectrons_max
729 fermi_level_max = fermi_level_guess
730 nelectrons_max = nelectrons_guess
731 ELSE IF (fermi_level_max - fermi_level_guess < fermi_level_guess - fermi_level_min)
THEN
732 fermi_level_max = fermi_level_guess
733 nelectrons_max = nelectrons_guess
735 fermi_level_min = fermi_level_guess
736 nelectrons_min = nelectrons_guess
743 negf_control%contacts(contact_id)%fermi_level = fermi_level_guess
745 IF (sub_env%ngroups > 1)
THEN
747 DEALLOCATE (matrix_s_fm)
753 IF (negf_control%contacts(contact_id)%shift_fermi_level)
THEN
754 delta_ef = negf_control%contacts(contact_id)%fermi_level_shifted - negf_control%contacts(contact_id)%fermi_level
755 IF (log_unit > 0)
WRITE (log_unit,
"(/,' The energies are shifted by (a.u.):',F18.8)") delta_ef
756 IF (log_unit > 0)
WRITE (log_unit,
"(' (eV):',F18.8)") delta_ef*
evolt
757 negf_control%contacts(contact_id)%fermi_level = negf_control%contacts(contact_id)%fermi_level_shifted
758 CALL get_qs_env(qs_env, dft_control=dft_control)
759 nspins = dft_control%nspins
760 CALL cp_fm_get_info(negf_env%contacts(contact_id)%s_00, nrow_global=nao)
768 IF (log_unit > 0)
THEN
769 WRITE (temperature_str,
'(F11.3)') negf_control%contacts(contact_id)%temperature*
kelvin
770 WRITE (log_unit,
'(/,T2,A,I0)')
"NEGF| Contact No. ", contact_id
771 WRITE (log_unit,
'(T2,A,T62,F18.8)')
"NEGF| Fermi level at "//trim(adjustl(temperature_str))// &
772 " Kelvin (a.u.):", negf_control%contacts(contact_id)%fermi_level
773 WRITE (log_unit,
'(T2,A,T62,F18.8)')
"NEGF| (eV):", &
774 negf_control%contacts(contact_id)%fermi_level*
evolt
775 WRITE (log_unit,
'(T2,A,T62,F18.8)')
"NEGF| Electric potential (a.u.):", &
776 negf_control%contacts(contact_id)%v_external
777 WRITE (log_unit,
'(T2,A,T62,F18.8)')
"NEGF| (Volt):", &
778 negf_control%contacts(contact_id)%v_external*
evolt
779 WRITE (log_unit,
'(T2,A,T62,F18.8)')
"NEGF| Electro-chemical potential Ef-|e|V (a.u.):", &
780 (negf_control%contacts(contact_id)%fermi_level - negf_control%contacts(contact_id)%v_external)
781 WRITE (log_unit,
'(T2,A,T62,F18.8)')
"NEGF| (eV):", &
782 (negf_control%contacts(contact_id)%fermi_level - negf_control%contacts(contact_id)%v_external)*
evolt
785 CALL timestop(handle)
786 END SUBROUTINE guess_fermi_level
799 SUBROUTINE shift_potential(negf_env, negf_control, sub_env, qs_env, base_contact, log_unit)
804 INTEGER,
INTENT(in) :: base_contact, log_unit
806 CHARACTER(LEN=*),
PARAMETER :: routinen =
'shift_potential'
809 COMPLEX(kind=dp) :: lbound_cpath, ubound_cpath, ubound_lpath
810 INTEGER :: handle, ispin, iter_count, nao, &
812 LOGICAL :: do_kpoints
813 REAL(kind=
dp) :: mu_base, nelectrons_guess, nelectrons_max, nelectrons_min, nelectrons_ref, &
814 t1, t2, temperature, trace, v_shift_guess, v_shift_max, v_shift_min
817 TYPE(
cp_fm_type),
ALLOCATABLE,
DIMENSION(:) :: rho_ao_fm
819 TYPE(
dbcsr_p_type),
DIMENSION(:, :),
POINTER :: rho_ao_qs_kp
822 DIMENSION(:) :: g_surf_circular, g_surf_linear
823 TYPE(integration_status_type) :: stats
828 ncontacts =
SIZE(negf_control%contacts)
830 IF (.NOT. (
ALLOCATED(negf_env%h_s) .AND.
ALLOCATED(negf_env%h_sc) .AND. &
831 ASSOCIATED(negf_env%s_s) .AND.
ALLOCATED(negf_env%s_sc)))
RETURN
832 IF (ncontacts < 2)
RETURN
833 IF (negf_control%v_shift_maxiters == 0)
RETURN
835 CALL timeset(routinen, handle)
837 CALL get_qs_env(qs_env, blacs_env=blacs_env, do_kpoints=do_kpoints, dft_control=dft_control, &
838 para_env=para_env, rho=rho_struct, subsys=subsys)
839 cpassert(.NOT. do_kpoints)
845 IF (sub_env%ngroups > 1)
THEN
846 NULLIFY (matrix_s_fm, fm_struct)
851 ALLOCATE (matrix_s_fm)
855 IF (sub_env%group_distribution(sub_env%mepos_global) == 0)
THEN
861 matrix_s_fm => negf_env%s_s
866 nspins =
SIZE(negf_env%h_s)
868 mu_base = negf_control%contacts(base_contact)%fermi_level
871 CALL qs_rho_get(rho_struct, rho_ao_kp=rho_ao_qs_kp)
874 nelectrons_ref = 0.0_dp
875 ALLOCATE (rho_ao_fm(nspins))
879 IF (.NOT. negf_control%is_restart)
THEN
882 fm=rho_ao_fm(ispin), &
883 atomlist_row=negf_control%atomlist_S_screening, &
884 atomlist_col=negf_control%atomlist_S_screening, &
885 subsys=subsys, mpi_comm_global=para_env, &
886 do_upper_diag=.true., do_lower=.true.)
888 CALL cp_fm_trace(rho_ao_fm(ispin), matrix_s_fm, trace)
889 nelectrons_ref = nelectrons_ref + trace
891 negf_env%nelectrons_ref = nelectrons_ref
893 nelectrons_ref = negf_env%nelectrons_ref
896 IF (log_unit > 0)
THEN
897 WRITE (log_unit,
'(/,T2,A)')
"COMPUTE SHIFT IN HARTREE POTENTIAL"
898 WRITE (log_unit,
"( ' ----------------------------------')")
899 WRITE (log_unit,
'(/,T2,A,T55,F25.14,/)')
"Initial electronic density of the scattering region:", -1.0_dp*nelectrons_ref
900 WRITE (log_unit,
'(T3,A)')
"Step Integration method Time V shift Convergence (density)"
901 WRITE (log_unit,
'(T3,78("-"))')
904 temperature = negf_control%contacts(base_contact)%temperature
907 lbound_cpath = cmplx(negf_control%energy_lbound, negf_control%eta, kind=
dp)
908 ubound_cpath = cmplx(mu_base - real(negf_control%gamma_kT, kind=
dp)*temperature, &
909 REAL(negf_control%delta_npoles, kind=
dp)*
twopi*temperature, kind=
dp)
912 ubound_lpath = cmplx(mu_base - log(negf_control%conv_density)*temperature, &
913 REAL(negf_control%delta_npoles, kind=
dp)*
twopi*temperature, kind=
dp)
915 v_shift_min = negf_control%v_shift
916 v_shift_max = negf_control%v_shift + negf_control%v_shift_offset
918 ALLOCATE (g_surf_circular(nspins), g_surf_linear(nspins))
920 DO iter_count = 1, negf_control%v_shift_maxiters
921 SELECT CASE (iter_count)
923 v_shift_guess = v_shift_min
925 v_shift_guess = v_shift_max
927 v_shift_guess = v_shift_min - (nelectrons_min - nelectrons_ref)* &
928 (v_shift_max - v_shift_min)/(nelectrons_max - nelectrons_min)
932 CALL integration_status_reset(stats)
936 CALL negf_init_rho_equiv_residuals(rho_ao_fm=rho_ao_fm(ispin), &
937 v_shift=v_shift_guess, &
938 ignore_bias=.true., &
940 negf_control=negf_control, &
943 base_contact=base_contact)
946 CALL negf_add_rho_equiv_low(rho_ao_fm=rho_ao_fm(ispin), &
948 v_shift=v_shift_guess, &
949 ignore_bias=.true., &
951 negf_control=negf_control, &
954 base_contact=base_contact, &
955 integr_lbound=lbound_cpath, &
956 integr_ubound=ubound_cpath, &
957 matrix_s_global=matrix_s_fm, &
958 is_circular=.true., &
959 g_surf_cache=g_surf_circular(ispin))
960 IF (negf_control%disable_cache) &
964 CALL negf_add_rho_equiv_low(rho_ao_fm=rho_ao_fm(ispin), &
966 v_shift=v_shift_guess, &
967 ignore_bias=.true., &
969 negf_control=negf_control, &
972 base_contact=base_contact, &
973 integr_lbound=ubound_cpath, &
974 integr_ubound=ubound_lpath, &
975 matrix_s_global=matrix_s_fm, &
976 is_circular=.false., &
977 g_surf_cache=g_surf_linear(ispin))
978 IF (negf_control%disable_cache) &
990 CALL cp_fm_trace(rho_ao_fm(1), matrix_s_fm, nelectrons_guess)
994 IF (log_unit > 0)
THEN
995 WRITE (log_unit,
'(T2,I5,T12,A,T32,F8.1,T42,F15.8,T60,ES20.5E2)') &
996 iter_count, get_method_description_string(stats, negf_control%integr_method), &
997 t2 - t1, v_shift_guess, nelectrons_guess - nelectrons_ref
1000 IF (abs(nelectrons_guess - nelectrons_ref) < negf_control%conv_scf)
EXIT
1003 SELECT CASE (iter_count)
1005 nelectrons_min = nelectrons_guess
1007 nelectrons_max = nelectrons_guess
1009 IF (v_shift_guess < v_shift_min)
THEN
1010 v_shift_max = v_shift_min
1011 nelectrons_max = nelectrons_min
1012 v_shift_min = v_shift_guess
1013 nelectrons_min = nelectrons_guess
1014 ELSE IF (v_shift_guess > v_shift_max)
THEN
1015 v_shift_min = v_shift_max
1016 nelectrons_min = nelectrons_max
1017 v_shift_max = v_shift_guess
1018 nelectrons_max = nelectrons_guess
1019 ELSE IF (v_shift_max - v_shift_guess < v_shift_guess - v_shift_min)
THEN
1020 v_shift_max = v_shift_guess
1021 nelectrons_max = nelectrons_guess
1023 v_shift_min = v_shift_guess
1024 nelectrons_min = nelectrons_guess
1031 negf_control%v_shift = v_shift_guess
1033 IF (log_unit > 0)
THEN
1034 WRITE (log_unit,
'(T2,A,T62,F18.8)')
"NEGF| Shift in Hartree potential (a.u.):", negf_control%v_shift
1035 WRITE (log_unit,
'(T2,A,T62,F18.8)')
"NEGF| (eV):", negf_control%v_shift*
evolt
1038 DO ispin = nspins, 1, -1
1042 DEALLOCATE (g_surf_circular, g_surf_linear)
1046 IF (sub_env%ngroups > 1 .AND.
ASSOCIATED(matrix_s_fm))
THEN
1048 DEALLOCATE (matrix_s_fm)
1051 CALL timestop(handle)
1052 END SUBROUTINE shift_potential
1067 SUBROUTINE converge_density(negf_env, negf_control, sub_env, qs_env, v_shift, base_contact, log_unit)
1072 REAL(kind=
dp),
INTENT(in) :: v_shift
1073 INTEGER,
INTENT(in) :: base_contact, log_unit
1075 CHARACTER(LEN=*),
PARAMETER :: routinen =
'converge_density'
1076 REAL(kind=
dp),
PARAMETER :: threshold = 16.0_dp*epsilon(0.0_dp)
1079 COMPLEX(kind=dp) :: lbound_cpath, ubound_cpath, ubound_lpath
1080 INTEGER :: handle, icontact, image, ispin, &
1081 iter_count, nao, ncontacts, nimages, &
1083 LOGICAL :: do_kpoints
1084 REAL(kind=
dp) :: delta, iter_delta, mu_base, nelectrons, &
1085 nelectrons_diff, t1, t2, temperature, &
1089 TYPE(
cp_fm_type),
ALLOCATABLE,
DIMENSION(:) :: rho_ao_delta_fm, rho_ao_new_fm
1091 TYPE(
dbcsr_p_type),
DIMENSION(:, :),
POINTER :: matrix_ks_initial_kp, matrix_ks_qs_kp, &
1092 rho_ao_initial_kp, rho_ao_new_kp, &
1096 DIMENSION(:) :: g_surf_circular, g_surf_linear, &
1098 TYPE(integration_status_type) :: stats
1103 ncontacts =
SIZE(negf_control%contacts)
1105 IF (ncontacts > 2)
THEN
1106 cpabort(
"Poisson solver does not support the general NEGF setup (>2 contacts).")
1109 IF (.NOT. (
ALLOCATED(negf_env%h_s) .AND.
ALLOCATED(negf_env%h_sc) .AND. &
1110 ASSOCIATED(negf_env%s_s) .AND.
ALLOCATED(negf_env%s_sc)))
RETURN
1111 IF (ncontacts < 2)
RETURN
1112 IF (negf_control%max_scf == 0)
RETURN
1114 CALL timeset(routinen, handle)
1116 IF (log_unit > 0)
THEN
1117 WRITE (log_unit,
'(/,T2,A)')
"NEGF SELF-CONSISTENT PROCEDURE"
1118 WRITE (log_unit,
"( ' ------------------------------')")
1121 IF (negf_control%update_HS .AND. (.NOT. negf_control%is_dft_entire)) &
1122 CALL qs_energies(qs_env, consistent_energies=.false., calc_forces=.false.)
1124 CALL get_qs_env(qs_env, blacs_env=blacs_env, do_kpoints=do_kpoints, dft_control=dft_control, &
1125 matrix_ks_kp=matrix_ks_qs_kp, para_env=para_env, rho=rho_struct, subsys=subsys)
1126 cpassert(.NOT. do_kpoints)
1132 IF (sub_env%ngroups > 1)
THEN
1133 NULLIFY (matrix_s_fm, fm_struct)
1138 ALLOCATE (matrix_s_fm)
1142 IF (sub_env%group_distribution(sub_env%mepos_global) == 0)
THEN
1148 matrix_s_fm => negf_env%s_s
1153 nspins =
SIZE(negf_env%h_s)
1154 nimages = dft_control%nimages
1156 v_base = negf_control%contacts(base_contact)%v_external
1157 mu_base = negf_control%contacts(base_contact)%fermi_level - v_base
1160 CALL qs_rho_get(rho_struct, rho_ao_kp=rho_ao_qs_kp)
1162 NULLIFY (matrix_ks_initial_kp, rho_ao_initial_kp, rho_ao_new_kp)
1167 DO image = 1, nimages
1168 DO ispin = 1, nspins
1169 CALL dbcsr_init_p(matrix_ks_initial_kp(ispin, image)%matrix)
1170 CALL dbcsr_copy(matrix_b=matrix_ks_initial_kp(ispin, image)%matrix, matrix_a=matrix_ks_qs_kp(ispin, image)%matrix)
1172 CALL dbcsr_init_p(rho_ao_initial_kp(ispin, image)%matrix)
1173 CALL dbcsr_copy(matrix_b=rho_ao_initial_kp(ispin, image)%matrix, matrix_a=rho_ao_qs_kp(ispin, image)%matrix)
1176 CALL dbcsr_copy(matrix_b=rho_ao_new_kp(ispin, image)%matrix, matrix_a=rho_ao_qs_kp(ispin, image)%matrix)
1182 ALLOCATE (rho_ao_delta_fm(nspins), rho_ao_new_fm(nspins))
1183 DO ispin = 1, nspins
1187 IF (.NOT. negf_control%is_restart)
THEN
1188 DO ispin = 1, nspins
1190 fm=rho_ao_delta_fm(ispin), &
1191 atomlist_row=negf_control%atomlist_S_screening, &
1192 atomlist_col=negf_control%atomlist_S_screening, &
1193 subsys=subsys, mpi_comm_global=para_env, &
1194 do_upper_diag=.true., do_lower=.true.)
1196 CALL cp_fm_trace(rho_ao_delta_fm(ispin), matrix_s_fm, trace)
1197 nelectrons = nelectrons + trace
1199 negf_env%nelectrons = nelectrons
1201 nelectrons = negf_env%nelectrons
1206 CALL mixing_allocate(qs_env, negf_env%mixing_method, nspins=nspins, mixing_store=negf_env%mixing_storage)
1207 IF (dft_control%qs_control%dftb .OR. dft_control%qs_control%xtb)
THEN
1208 cpabort(
'TB Code not available')
1209 ELSE IF (dft_control%qs_control%semi_empirical)
THEN
1210 cpabort(
'SE Code not possible')
1212 CALL mixing_init(negf_env%mixing_method, rho_struct, negf_env%mixing_storage, para_env)
1216 IF (log_unit > 0)
THEN
1217 WRITE (log_unit,
'(/,T2,A,T55,F25.14,/)')
" Initial electronic density of the scattering region:", -1.0_dp*nelectrons
1218 WRITE (log_unit,
'(T3,A)')
"Step Integration method Time Electronic density Convergence"
1219 WRITE (log_unit,
'(T3,78("-"))')
1222 temperature = negf_control%contacts(base_contact)%temperature
1225 lbound_cpath = cmplx(negf_control%energy_lbound, negf_control%eta, kind=
dp)
1226 ubound_cpath = cmplx(mu_base - real(negf_control%gamma_kT, kind=
dp)*temperature, &
1227 REAL(negf_control%delta_npoles, kind=
dp)*
twopi*temperature, kind=
dp)
1230 ubound_lpath = cmplx(mu_base - log(negf_control%conv_density)*temperature, &
1231 REAL(negf_control%delta_npoles, kind=
dp)*
twopi*temperature, kind=
dp)
1233 ALLOCATE (g_surf_circular(nspins), g_surf_linear(nspins), g_surf_nonequiv(nspins))
1236 DO iter_count = 1, negf_control%max_scf
1238 CALL integration_status_reset(stats)
1240 DO ispin = 1, nspins
1242 CALL negf_init_rho_equiv_residuals(rho_ao_fm=rho_ao_new_fm(ispin), &
1244 ignore_bias=.false., &
1245 negf_env=negf_env, &
1246 negf_control=negf_control, &
1249 base_contact=base_contact)
1252 CALL negf_add_rho_equiv_low(rho_ao_fm=rho_ao_new_fm(ispin), &
1255 ignore_bias=.false., &
1256 negf_env=negf_env, &
1257 negf_control=negf_control, &
1260 base_contact=base_contact, &
1261 integr_lbound=lbound_cpath, &
1262 integr_ubound=ubound_cpath, &
1263 matrix_s_global=matrix_s_fm, &
1264 is_circular=.true., &
1265 g_surf_cache=g_surf_circular(ispin))
1266 IF (negf_control%disable_cache) &
1270 CALL negf_add_rho_equiv_low(rho_ao_fm=rho_ao_new_fm(ispin), &
1273 ignore_bias=.false., &
1274 negf_env=negf_env, &
1275 negf_control=negf_control, &
1278 base_contact=base_contact, &
1279 integr_lbound=ubound_cpath, &
1280 integr_ubound=ubound_lpath, &
1281 matrix_s_global=matrix_s_fm, &
1282 is_circular=.false., &
1283 g_surf_cache=g_surf_linear(ispin))
1284 IF (negf_control%disable_cache) &
1289 DO icontact = 1, ncontacts
1290 IF (icontact /= base_contact)
THEN
1291 delta = delta + abs(negf_control%contacts(icontact)%v_external - &
1292 negf_control%contacts(base_contact)%v_external) + &
1293 abs(negf_control%contacts(icontact)%fermi_level - &
1294 negf_control%contacts(base_contact)%fermi_level) + &
1295 abs(negf_control%contacts(icontact)%temperature - &
1296 negf_control%contacts(base_contact)%temperature)
1299 IF (delta >= threshold)
THEN
1300 CALL negf_add_rho_nonequiv(rho_ao_fm=rho_ao_new_fm(ispin), &
1303 negf_env=negf_env, &
1304 negf_control=negf_control, &
1307 base_contact=base_contact, &
1308 matrix_s_global=matrix_s_fm, &
1309 g_surf_cache=g_surf_nonequiv(ispin))
1310 IF (negf_control%disable_cache) &
1315 IF (nspins == 1)
CALL cp_fm_scale(2.0_dp, rho_ao_new_fm(1))
1318 nelectrons_diff = 0.0_dp
1319 DO ispin = 1, nspins
1320 CALL cp_fm_trace(rho_ao_new_fm(ispin), matrix_s_fm, trace)
1321 nelectrons = nelectrons + trace
1325 CALL cp_fm_trace(rho_ao_delta_fm(ispin), matrix_s_fm, trace)
1326 nelectrons_diff = nelectrons_diff + trace
1329 CALL cp_fm_to_fm(rho_ao_new_fm(ispin), rho_ao_delta_fm(ispin))
1334 IF (log_unit > 0)
THEN
1335 WRITE (log_unit,
'(T2,I5,T12,A,T32,F8.1,T43,F20.8,T65,ES15.5E2)') &
1336 iter_count, get_method_description_string(stats, negf_control%integr_method), &
1337 t2 - t1, -1.0_dp*nelectrons, nelectrons_diff
1340 IF (abs(nelectrons_diff) < negf_control%conv_scf)
EXIT
1346 DO image = 1, nimages
1347 DO ispin = 1, nspins
1348 CALL dbcsr_copy(matrix_b=rho_ao_new_kp(ispin, image)%matrix, &
1349 matrix_a=rho_ao_initial_kp(ispin, image)%matrix)
1353 DO ispin = 1, nspins
1355 matrix=rho_ao_new_kp(ispin, 1)%matrix, &
1356 atomlist_row=negf_control%atomlist_S_screening, &
1357 atomlist_col=negf_control%atomlist_S_screening, &
1362 para_env, iter_delta, iter_count)
1364 DO image = 1, nimages
1365 DO ispin = 1, nspins
1366 CALL dbcsr_copy(rho_ao_qs_kp(ispin, image)%matrix, rho_ao_new_kp(ispin, image)%matrix)
1372 DO image = 1, nimages
1373 DO ispin = 1, nspins
1374 CALL dbcsr_copy(matrix_b=rho_ao_qs_kp(ispin, image)%matrix, &
1375 matrix_a=rho_ao_initial_kp(ispin, image)%matrix)
1379 DO ispin = 1, nspins
1381 matrix=rho_ao_qs_kp(ispin, 1)%matrix, &
1382 atomlist_row=negf_control%atomlist_S_screening, &
1383 atomlist_col=negf_control%atomlist_S_screening, &
1391 CALL gspace_mixing(qs_env, negf_env%mixing_method, negf_env%mixing_storage, &
1392 rho_struct, para_env, iter_count)
1395 IF (negf_control%update_HS)
THEN
1399 DO ispin = 1, nspins
1401 fm=negf_env%h_s(ispin), &
1402 atomlist_row=negf_control%atomlist_S_screening, &
1403 atomlist_col=negf_control%atomlist_S_screening, &
1404 subsys=subsys, mpi_comm_global=para_env, &
1405 do_upper_diag=.true., do_lower=.true.)
1413 IF (log_unit > 0)
THEN
1414 IF (iter_count <= negf_control%max_scf)
THEN
1415 WRITE (log_unit,
'(/,T11,1X,A,I0,A)')
"*** NEGF run converged in ", iter_count,
" iteration(s) ***"
1417 WRITE (log_unit,
'(/,T11,1X,A,I0,A)')
"*** NEGF run did NOT converge after ", iter_count - 1,
" iteration(s) ***"
1421 DO ispin = nspins, 1, -1
1426 DEALLOCATE (g_surf_circular, g_surf_linear, g_surf_nonequiv)
1431 DO image = 1, nimages
1432 DO ispin = 1, nspins
1433 CALL dbcsr_copy(matrix_b=matrix_ks_qs_kp(ispin, image)%matrix, matrix_a=matrix_ks_initial_kp(ispin, image)%matrix)
1434 CALL dbcsr_copy(matrix_b=rho_ao_qs_kp(ispin, image)%matrix, matrix_a=rho_ao_initial_kp(ispin, image)%matrix)
1441 DEALLOCATE (matrix_ks_initial_kp, rho_ao_new_kp, rho_ao_initial_kp)
1443 IF (sub_env%ngroups > 1 .AND.
ASSOCIATED(matrix_s_fm))
THEN
1445 DEALLOCATE (matrix_s_fm)
1448 CALL timestop(handle)
1449 END SUBROUTINE converge_density
1466 SUBROUTINE negf_surface_green_function_batch(g_surf, omega, h0, s0, h1, s1, sub_env, v_external, conv, transp)
1467 TYPE(
cp_cfm_type),
DIMENSION(:),
INTENT(inout) :: g_surf
1468 COMPLEX(kind=dp),
DIMENSION(:),
INTENT(in) :: omega
1469 TYPE(
cp_fm_type),
INTENT(IN) :: h0, s0, h1, s1
1471 REAL(kind=
dp),
INTENT(in) :: v_external, conv
1472 LOGICAL,
INTENT(in) :: transp
1474 CHARACTER(len=*),
PARAMETER :: routinen =
'negf_surface_green_function_batch'
1477 INTEGER :: handle, igroup, ipoint, npoints
1481 CALL timeset(routinen, handle)
1482 npoints =
SIZE(omega)
1487 igroup = sub_env%group_distribution(sub_env%mepos_global)
1489 g_surf(1:npoints) = cfm_null
1491 DO ipoint = igroup + 1, npoints, sub_env%ngroups
1492 IF (debug_this_module)
THEN
1493 cpassert(.NOT.
ASSOCIATED(g_surf(ipoint)%matrix_struct))
1497 CALL do_sancho(g_surf(ipoint), omega(ipoint) + v_external, &
1498 h0, s0, h1, s1, conv, transp, work)
1502 CALL timestop(handle)
1503 END SUBROUTINE negf_surface_green_function_batch
1535 SUBROUTINE negf_retarded_green_function_batch(omega, v_shift, ignore_bias, negf_env, negf_control, sub_env, ispin, &
1537 g_ret_s, g_ret_scale, gamma_contacts, gret_gamma_gadv, dos, &
1538 transm_coeff, transm_contact1, transm_contact2, just_contact)
1539 COMPLEX(kind=dp),
DIMENSION(:),
INTENT(in) :: omega
1540 REAL(kind=
dp),
INTENT(in) :: v_shift
1541 LOGICAL,
INTENT(in) :: ignore_bias
1545 INTEGER,
INTENT(in) :: ispin
1546 TYPE(
cp_cfm_type),
DIMENSION(:, :),
INTENT(in) :: g_surf_contacts
1549 COMPLEX(kind=dp),
DIMENSION(:),
INTENT(in), &
1550 OPTIONAL :: g_ret_scale
1552 OPTIONAL :: gamma_contacts, gret_gamma_gadv
1553 REAL(kind=
dp),
DIMENSION(:),
INTENT(out),
OPTIONAL :: dos
1554 COMPLEX(kind=dp),
DIMENSION(:),
INTENT(out), &
1555 OPTIONAL :: transm_coeff
1556 INTEGER,
INTENT(in),
OPTIONAL :: transm_contact1, transm_contact2, &
1559 CHARACTER(len=*),
PARAMETER :: routinen =
'negf_retarded_green_function_batch'
1561 INTEGER :: handle, icontact, igroup, ipoint, &
1562 ncontacts, npoints, nrows
1563 REAL(kind=
dp) :: v_external
1565 DIMENSION(:) :: info1
1567 DIMENSION(:, :) :: info2
1568 TYPE(
cp_cfm_type),
ALLOCATABLE,
DIMENSION(:) :: g_ret_s_group, self_energy_contacts, &
1569 zwork1_contacts, zwork2_contacts
1570 TYPE(
cp_cfm_type),
ALLOCATABLE,
DIMENSION(:, :) :: gamma_contacts_group, &
1571 gret_gamma_gadv_group
1577 CALL timeset(routinen, handle)
1578 npoints =
SIZE(omega)
1579 ncontacts =
SIZE(negf_env%contacts)
1580 cpassert(
SIZE(negf_control%contacts) == ncontacts)
1582 IF (
PRESENT(just_contact))
THEN
1583 cpassert(just_contact <= ncontacts)
1587 cpassert(ncontacts >= 2)
1589 IF (ignore_bias) v_external = 0.0_dp
1591 IF (
PRESENT(transm_coeff) .OR.
PRESENT(transm_contact1) .OR.
PRESENT(transm_contact2))
THEN
1592 cpassert(
PRESENT(transm_coeff))
1593 cpassert(
PRESENT(transm_contact1))
1594 cpassert(
PRESENT(transm_contact2))
1595 cpassert(.NOT.
PRESENT(just_contact))
1598 ALLOCATE (self_energy_contacts(ncontacts), zwork1_contacts(ncontacts), zwork2_contacts(ncontacts))
1600 IF (
PRESENT(just_contact))
THEN
1601 CALL cp_fm_get_info(negf_env%contacts(just_contact)%s_01, matrix_struct=fm_struct)
1602 DO icontact = 1, ncontacts
1607 CALL cp_fm_get_info(negf_env%contacts(just_contact)%s_00, nrow_global=nrows, matrix_struct=fm_struct)
1608 DO icontact = 1, ncontacts
1609 CALL cp_cfm_create(self_energy_contacts(icontact), fm_struct)
1612 DO icontact = 1, ncontacts
1613 CALL cp_fm_get_info(negf_env%s_sc(icontact), matrix_struct=fm_struct)
1618 CALL cp_fm_get_info(negf_env%s_s, nrow_global=nrows, matrix_struct=fm_struct)
1619 DO icontact = 1, ncontacts
1620 CALL cp_cfm_create(self_energy_contacts(icontact), fm_struct)
1624 IF (
PRESENT(g_ret_s) .OR.
PRESENT(gret_gamma_gadv) .OR. &
1625 PRESENT(dos) .OR.
PRESENT(transm_coeff))
THEN
1626 ALLOCATE (g_ret_s_group(npoints))
1628 IF (sub_env%ngroups <= 1 .AND.
PRESENT(g_ret_s))
THEN
1629 g_ret_s_group(1:npoints) = g_ret_s(1:npoints)
1633 IF (
PRESENT(gamma_contacts) .OR.
PRESENT(gret_gamma_gadv) .OR.
PRESENT(transm_coeff))
THEN
1634 IF (debug_this_module .AND.
PRESENT(gamma_contacts))
THEN
1635 cpassert(
SIZE(gamma_contacts, 1) == ncontacts)
1638 ALLOCATE (gamma_contacts_group(ncontacts, npoints))
1639 IF (sub_env%ngroups <= 1 .AND.
PRESENT(gamma_contacts))
THEN
1640 gamma_contacts_group(1:ncontacts, 1:npoints) = gamma_contacts(1:ncontacts, 1:npoints)
1644 IF (
PRESENT(gret_gamma_gadv))
THEN
1645 IF (debug_this_module .AND.
PRESENT(gret_gamma_gadv))
THEN
1646 cpassert(
SIZE(gret_gamma_gadv, 1) == ncontacts)
1649 ALLOCATE (gret_gamma_gadv_group(ncontacts, npoints))
1650 IF (sub_env%ngroups <= 1)
THEN
1651 gret_gamma_gadv_group(1:ncontacts, 1:npoints) = gret_gamma_gadv(1:ncontacts, 1:npoints)
1655 igroup = sub_env%group_distribution(sub_env%mepos_global)
1657 DO ipoint = 1, npoints
1658 IF (
ASSOCIATED(g_surf_contacts(1, ipoint)%matrix_struct))
THEN
1659 IF (sub_env%ngroups > 1 .OR. .NOT.
PRESENT(g_ret_s))
THEN
1663 IF (
ALLOCATED(g_ret_s_group))
THEN
1668 IF (sub_env%ngroups > 1 .OR. .NOT.
PRESENT(gamma_contacts))
THEN
1669 IF (
ALLOCATED(gamma_contacts_group))
THEN
1670 DO icontact = 1, ncontacts
1671 CALL cp_cfm_create(gamma_contacts_group(icontact, ipoint), fm_struct)
1676 IF (sub_env%ngroups > 1)
THEN
1677 IF (
ALLOCATED(gret_gamma_gadv_group))
THEN
1678 DO icontact = 1, ncontacts
1679 IF (
ASSOCIATED(gret_gamma_gadv(icontact, ipoint)%matrix_struct))
THEN
1680 CALL cp_cfm_create(gret_gamma_gadv_group(icontact, ipoint), fm_struct)
1686 IF (
PRESENT(just_contact))
THEN
1688 DO icontact = 1, ncontacts
1690 omega=omega(ipoint), &
1691 g_surf_c=g_surf_contacts(icontact, ipoint), &
1692 h_sc0=negf_env%contacts(just_contact)%h_01(ispin), &
1693 s_sc0=negf_env%contacts(just_contact)%s_01, &
1694 zwork1=zwork1_contacts(icontact), &
1695 zwork2=zwork2_contacts(icontact), &
1696 transp=(icontact == 1))
1700 DO icontact = 1, ncontacts
1701 IF (.NOT. ignore_bias) v_external = negf_control%contacts(icontact)%v_external
1704 omega=omega(ipoint) + v_external, &
1705 g_surf_c=g_surf_contacts(icontact, ipoint), &
1706 h_sc0=negf_env%h_sc(ispin, icontact), &
1707 s_sc0=negf_env%s_sc(icontact), &
1708 zwork1=zwork1_contacts(icontact), &
1709 zwork2=zwork2_contacts(icontact), &
1715 IF (
ALLOCATED(gamma_contacts_group))
THEN
1716 DO icontact = 1, ncontacts
1718 self_energy_c=self_energy_contacts(icontact))
1722 IF (
ALLOCATED(g_ret_s_group))
THEN
1724 DO icontact = 2, ncontacts
1729 IF (
PRESENT(just_contact))
THEN
1731 omega=omega(ipoint) - v_shift, &
1732 self_energy_ret_sum=self_energy_contacts(1), &
1733 h_s=negf_env%contacts(just_contact)%h_00(ispin), &
1734 s_s=negf_env%contacts(just_contact)%s_00)
1735 ELSE IF (ignore_bias)
THEN
1737 omega=omega(ipoint) - v_shift, &
1738 self_energy_ret_sum=self_energy_contacts(1), &
1739 h_s=negf_env%h_s(ispin), &
1743 omega=omega(ipoint) - v_shift, &
1744 self_energy_ret_sum=self_energy_contacts(1), &
1745 h_s=negf_env%h_s(ispin), &
1747 v_hartree_s=negf_env%v_hartree_s)
1750 IF (
PRESENT(g_ret_scale))
THEN
1751 IF (g_ret_scale(ipoint) /=
z_one)
CALL cp_cfm_scale(g_ret_scale(ipoint), g_ret_s_group(ipoint))
1755 IF (
ALLOCATED(gret_gamma_gadv_group))
THEN
1758 DO icontact = 1, ncontacts
1759 IF (
ASSOCIATED(gret_gamma_gadv_group(icontact, ipoint)%matrix_struct))
THEN
1761 z_one, gamma_contacts_group(icontact, ipoint), &
1762 g_ret_s_group(ipoint), &
1763 z_zero, self_energy_contacts(icontact))
1765 z_one, g_ret_s_group(ipoint), &
1766 self_energy_contacts(icontact), &
1767 z_zero, gret_gamma_gadv_group(icontact, ipoint))
1775 IF (
PRESENT(g_ret_s))
THEN
1776 IF (sub_env%ngroups > 1)
THEN
1778 DO ipoint = 1, npoints
1779 IF (
ASSOCIATED(g_ret_s(ipoint)%matrix_struct))
THEN
1785 IF (
ASSOCIATED(para_env))
THEN
1786 ALLOCATE (info1(npoints))
1788 DO ipoint = 1, npoints
1791 para_env, info1(ipoint))
1794 DO ipoint = 1, npoints
1795 IF (
ASSOCIATED(g_ret_s(ipoint)%matrix_struct))
THEN
1797 IF (
ASSOCIATED(g_ret_s_group(ipoint)%matrix_struct)) &
1807 IF (
PRESENT(gamma_contacts))
THEN
1808 IF (sub_env%ngroups > 1)
THEN
1810 pnt1:
DO ipoint = 1, npoints
1811 DO icontact = 1, ncontacts
1812 IF (
ASSOCIATED(gamma_contacts(icontact, ipoint)%matrix_struct))
THEN
1813 CALL cp_cfm_get_info(gamma_contacts(icontact, ipoint), para_env=para_env)
1819 IF (
ASSOCIATED(para_env))
THEN
1820 ALLOCATE (info2(ncontacts, npoints))
1822 DO ipoint = 1, npoints
1823 DO icontact = 1, ncontacts
1825 gamma_contacts(icontact, ipoint), &
1826 para_env, info2(icontact, ipoint))
1830 DO ipoint = 1, npoints
1831 DO icontact = 1, ncontacts
1832 IF (
ASSOCIATED(gamma_contacts(icontact, ipoint)%matrix_struct))
THEN
1834 IF (
ASSOCIATED(gamma_contacts_group(icontact, ipoint)%matrix_struct))
THEN
1846 IF (
PRESENT(gret_gamma_gadv))
THEN
1847 IF (sub_env%ngroups > 1)
THEN
1849 pnt2:
DO ipoint = 1, npoints
1850 DO icontact = 1, ncontacts
1851 IF (
ASSOCIATED(gret_gamma_gadv(icontact, ipoint)%matrix_struct))
THEN
1852 CALL cp_cfm_get_info(gret_gamma_gadv(icontact, ipoint), para_env=para_env)
1858 IF (
ASSOCIATED(para_env))
THEN
1859 ALLOCATE (info2(ncontacts, npoints))
1861 DO ipoint = 1, npoints
1862 DO icontact = 1, ncontacts
1864 gret_gamma_gadv(icontact, ipoint), &
1865 para_env, info2(icontact, ipoint))
1869 DO ipoint = 1, npoints
1870 DO icontact = 1, ncontacts
1871 IF (
ASSOCIATED(gret_gamma_gadv(icontact, ipoint)%matrix_struct))
THEN
1873 IF (
ASSOCIATED(gret_gamma_gadv_group(icontact, ipoint)%matrix_struct))
THEN
1885 IF (
PRESENT(dos))
THEN
1888 IF (
PRESENT(just_contact))
THEN
1889 matrix_s => negf_env%contacts(just_contact)%s_00
1891 matrix_s => negf_env%s_s
1897 DO ipoint = 1, npoints
1898 IF (
ASSOCIATED(g_ret_s_group(ipoint)%matrix_struct))
THEN
1899 CALL cp_cfm_to_fm(g_ret_s_group(ipoint), mtargeti=g_ret_imag)
1900 CALL cp_fm_trace(g_ret_imag, matrix_s, dos(ipoint))
1901 IF (sub_env%para_env%mepos /= 0) dos(ipoint) = 0.0_dp
1907 CALL sub_env%mpi_comm_global%sum(dos)
1908 dos(:) = -1.0_dp/
pi*dos(:)
1911 IF (
PRESENT(transm_coeff))
THEN
1914 DO ipoint = 1, npoints
1915 IF (
ASSOCIATED(g_ret_s_group(ipoint)%matrix_struct))
THEN
1918 z_one, gamma_contacts_group(transm_contact1, ipoint), &
1919 g_ret_s_group(ipoint), &
1920 z_zero, self_energy_contacts(transm_contact1))
1922 z_one, self_energy_contacts(transm_contact1), &
1923 gamma_contacts_group(transm_contact2, ipoint), &
1924 z_zero, self_energy_contacts(transm_contact2))
1928 self_energy_contacts(transm_contact2), &
1929 transm_coeff(ipoint))
1930 IF (sub_env%para_env%mepos /= 0) transm_coeff(ipoint) = 0.0_dp
1935 CALL sub_env%mpi_comm_global%sum(transm_coeff)
1940 IF (
ALLOCATED(g_ret_s_group))
THEN
1941 DO ipoint = npoints, 1, -1
1942 IF (sub_env%ngroups > 1 .OR. .NOT.
PRESENT(g_ret_s))
THEN
1946 DEALLOCATE (g_ret_s_group)
1949 IF (
ALLOCATED(gamma_contacts_group))
THEN
1950 DO ipoint = npoints, 1, -1
1951 DO icontact = ncontacts, 1, -1
1952 IF (sub_env%ngroups > 1 .OR. .NOT.
PRESENT(gamma_contacts))
THEN
1957 DEALLOCATE (gamma_contacts_group)
1960 IF (
ALLOCATED(gret_gamma_gadv_group))
THEN
1961 DO ipoint = npoints, 1, -1
1962 DO icontact = ncontacts, 1, -1
1963 IF (sub_env%ngroups > 1)
THEN
1968 DEALLOCATE (gret_gamma_gadv_group)
1971 IF (
ALLOCATED(self_energy_contacts))
THEN
1972 DO icontact = ncontacts, 1, -1
1975 DEALLOCATE (self_energy_contacts)
1978 IF (
ALLOCATED(zwork1_contacts))
THEN
1979 DO icontact = ncontacts, 1, -1
1982 DEALLOCATE (zwork1_contacts)
1985 IF (
ALLOCATED(zwork2_contacts))
THEN
1986 DO icontact = ncontacts, 1, -1
1989 DEALLOCATE (zwork2_contacts)
1992 CALL timestop(handle)
1993 END SUBROUTINE negf_retarded_green_function_batch
2003 PURE FUNCTION fermi_function(omega, temperature)
RESULT(val)
2004 COMPLEX(kind=dp),
INTENT(in) :: omega
2005 REAL(kind=
dp),
INTENT(in) :: temperature
2006 COMPLEX(kind=dp) :: val
2008 REAL(kind=
dp),
PARAMETER :: max_ln_omega_over_t = log(huge(0.0_dp))/16.0_dp
2010 IF (real(omega, kind=
dp) <= temperature*max_ln_omega_over_t)
THEN
2016 END FUNCTION fermi_function
2031 SUBROUTINE negf_init_rho_equiv_residuals(rho_ao_fm, v_shift, ignore_bias, negf_env, &
2032 negf_control, sub_env, ispin, base_contact, just_contact)
2034 REAL(kind=
dp),
INTENT(in) :: v_shift
2035 LOGICAL,
INTENT(in) :: ignore_bias
2039 INTEGER,
INTENT(in) :: ispin, base_contact
2040 INTEGER,
INTENT(in),
OPTIONAL :: just_contact
2042 CHARACTER(LEN=*),
PARAMETER :: routinen =
'negf_init_rho_equiv_residuals'
2044 COMPLEX(kind=dp),
ALLOCATABLE,
DIMENSION(:) :: omega
2045 INTEGER :: handle, icontact, ipole, ncontacts, &
2047 REAL(kind=
dp) :: mu_base, pi_temperature, temperature, &
2049 TYPE(
cp_cfm_type),
ALLOCATABLE,
DIMENSION(:) :: g_ret_s
2054 CALL timeset(routinen, handle)
2056 temperature = negf_control%contacts(base_contact)%temperature
2057 IF (ignore_bias)
THEN
2058 mu_base = negf_control%contacts(base_contact)%fermi_level
2061 mu_base = negf_control%contacts(base_contact)%fermi_level - negf_control%contacts(base_contact)%v_external
2064 pi_temperature =
pi*temperature
2065 npoles = negf_control%delta_npoles
2067 ncontacts =
SIZE(negf_env%contacts)
2068 cpassert(base_contact <= ncontacts)
2069 IF (
PRESENT(just_contact))
THEN
2071 cpassert(just_contact == base_contact)
2074 IF (npoles > 0)
THEN
2075 CALL cp_fm_get_info(rho_ao_fm, para_env=para_env, matrix_struct=fm_struct)
2077 ALLOCATE (omega(npoles), g_ret_s(npoles))
2079 DO ipole = 1, npoles
2082 omega(ipole) = cmplx(mu_base, real(2*ipole - 1, kind=
dp)*pi_temperature, kind=
dp)
2087 IF (
PRESENT(just_contact))
THEN
2092 DO icontact = 1, ncontacts
2093 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, :), &
2095 h0=negf_env%contacts(just_contact)%h_00(ispin), &
2096 s0=negf_env%contacts(just_contact)%s_00, &
2097 h1=negf_env%contacts(just_contact)%h_01(ispin), &
2098 s1=negf_env%contacts(just_contact)%s_01, &
2099 sub_env=sub_env, v_external=0.0_dp, &
2100 conv=negf_control%conv_green, transp=(icontact == 1))
2103 DO icontact = 1, ncontacts
2104 IF (.NOT. ignore_bias) v_external = negf_control%contacts(icontact)%v_external
2106 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, :), &
2108 h0=negf_env%contacts(icontact)%h_00(ispin), &
2109 s0=negf_env%contacts(icontact)%s_00, &
2110 h1=negf_env%contacts(icontact)%h_01(ispin), &
2111 s1=negf_env%contacts(icontact)%s_01, &
2113 v_external=v_external, &
2114 conv=negf_control%conv_green, transp=.false.)
2118 CALL negf_retarded_green_function_batch(omega=omega(:), &
2120 ignore_bias=ignore_bias, &
2121 negf_env=negf_env, &
2122 negf_control=negf_control, &
2125 g_surf_contacts=g_surf_cache%g_surf_contacts, &
2127 just_contact=just_contact)
2131 DO ipole = 2, npoles
2139 DO ipole = npoles, 1, -1
2142 DEALLOCATE (g_ret_s, omega)
2145 CALL timestop(handle)
2146 END SUBROUTINE negf_init_rho_equiv_residuals
2167 SUBROUTINE negf_add_rho_equiv_low(rho_ao_fm, stats, v_shift, ignore_bias, negf_env, negf_control, sub_env, &
2168 ispin, base_contact, integr_lbound, integr_ubound, matrix_s_global, &
2169 is_circular, g_surf_cache, just_contact)
2171 TYPE(integration_status_type),
INTENT(inout) :: stats
2172 REAL(kind=
dp),
INTENT(in) :: v_shift
2173 LOGICAL,
INTENT(in) :: ignore_bias
2177 INTEGER,
INTENT(in) :: ispin, base_contact
2178 COMPLEX(kind=dp),
INTENT(in) :: integr_lbound, integr_ubound
2179 TYPE(
cp_fm_type),
INTENT(IN) :: matrix_s_global
2180 LOGICAL,
INTENT(in) :: is_circular
2182 INTEGER,
INTENT(in),
OPTIONAL :: just_contact
2184 CHARACTER(LEN=*),
PARAMETER :: routinen =
'negf_add_rho_equiv_low'
2186 COMPLEX(kind=dp),
ALLOCATABLE,
DIMENSION(:) :: xnodes, zscale
2187 INTEGER :: handle, icontact, interval_id, ipoint, max_points, min_points, ncontacts, &
2188 npoints, npoints_exist, npoints_tmp, npoints_total, shape_id
2189 LOGICAL :: do_surface_green
2190 REAL(kind=
dp) :: conv_integr, mu_base, temperature, &
2193 TYPE(
cp_cfm_type),
ALLOCATABLE,
DIMENSION(:) :: zdata, zdata_tmp
2199 CALL timeset(routinen, handle)
2203 conv_integr = 0.5_dp*negf_control%conv_density*
pi
2205 IF (ignore_bias)
THEN
2206 mu_base = negf_control%contacts(base_contact)%fermi_level
2209 mu_base = negf_control%contacts(base_contact)%fermi_level - negf_control%contacts(base_contact)%v_external
2212 min_points = negf_control%integr_min_points
2213 max_points = negf_control%integr_max_points
2214 temperature = negf_control%contacts(base_contact)%temperature
2216 ncontacts =
SIZE(negf_env%contacts)
2217 cpassert(base_contact <= ncontacts)
2218 IF (
PRESENT(just_contact))
THEN
2220 cpassert(just_contact == base_contact)
2223 do_surface_green = .NOT.
ALLOCATED(g_surf_cache%tnodes)
2225 IF (do_surface_green)
THEN
2226 npoints = min_points
2228 npoints =
SIZE(g_surf_cache%tnodes)
2232 CALL cp_fm_get_info(rho_ao_fm, para_env=para_env, matrix_struct=fm_struct)
2235 SELECT CASE (negf_control%integr_method)
2238 ALLOCATE (xnodes(npoints))
2240 IF (is_circular)
THEN
2248 IF (do_surface_green)
THEN
2249 CALL ccquad_init(cc_env, xnodes, npoints, integr_lbound, integr_ubound, &
2250 interval_id, shape_id, matrix_s_global)
2252 CALL ccquad_init(cc_env, xnodes, npoints, integr_lbound, integr_ubound, &
2253 interval_id, shape_id, matrix_s_global, tnodes_restart=g_surf_cache%tnodes)
2256 ALLOCATE (zdata(npoints))
2257 DO ipoint = 1, npoints
2262 IF (do_surface_green)
THEN
2265 IF (
PRESENT(just_contact))
THEN
2267 DO icontact = 1, ncontacts
2268 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, npoints_total + 1:), &
2269 omega=xnodes(1:npoints), &
2270 h0=negf_env%contacts(just_contact)%h_00(ispin), &
2271 s0=negf_env%contacts(just_contact)%s_00, &
2272 h1=negf_env%contacts(just_contact)%h_01(ispin), &
2273 s1=negf_env%contacts(just_contact)%s_01, &
2274 sub_env=sub_env, v_external=0.0_dp, &
2275 conv=negf_control%conv_green, transp=(icontact == 1))
2278 DO icontact = 1, ncontacts
2279 IF (.NOT. ignore_bias) v_external = negf_control%contacts(icontact)%v_external
2281 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, npoints_total + 1:), &
2282 omega=xnodes(1:npoints), &
2283 h0=negf_env%contacts(icontact)%h_00(ispin), &
2284 s0=negf_env%contacts(icontact)%s_00, &
2285 h1=negf_env%contacts(icontact)%h_01(ispin), &
2286 s1=negf_env%contacts(icontact)%s_01, &
2288 v_external=v_external, &
2289 conv=negf_control%conv_green, transp=.false.)
2294 ALLOCATE (zscale(npoints))
2296 IF (temperature >= 0.0_dp)
THEN
2297 DO ipoint = 1, npoints
2298 zscale(ipoint) = fermi_function(xnodes(ipoint) - mu_base, temperature)
2304 CALL negf_retarded_green_function_batch(omega=xnodes(1:npoints), &
2306 ignore_bias=ignore_bias, &
2307 negf_env=negf_env, &
2308 negf_control=negf_control, &
2311 g_surf_contacts=g_surf_cache%g_surf_contacts(:, npoints_total + 1:), &
2312 g_ret_s=zdata(1:npoints), &
2313 g_ret_scale=zscale(1:npoints), &
2314 just_contact=just_contact)
2316 DEALLOCATE (xnodes, zscale)
2317 npoints_total = npoints_total + npoints
2320 CALL move_alloc(zdata, zdata_tmp)
2324 IF (cc_env%error <= conv_integr)
EXIT
2325 IF (2*(npoints_total - 1) + 1 > max_points)
EXIT
2329 do_surface_green = .true.
2331 npoints_tmp = npoints
2333 npoints =
SIZE(xnodes)
2335 ALLOCATE (zdata(npoints))
2338 DO ipoint = 1, npoints_tmp
2339 IF (
ASSOCIATED(zdata_tmp(ipoint)%matrix_struct))
THEN
2340 npoints_exist = npoints_exist + 1
2341 zdata(npoints_exist) = zdata_tmp(ipoint)
2344 DEALLOCATE (zdata_tmp)
2346 DO ipoint = npoints_exist + 1, npoints
2352 stats%error = stats%error + cc_env%error/
pi
2354 DO ipoint =
SIZE(zdata_tmp), 1, -1
2357 DEALLOCATE (zdata_tmp)
2359 CALL cp_cfm_to_fm(cc_env%integral, mtargeti=integral_imag)
2362 IF (do_surface_green)
THEN
2369 ALLOCATE (xnodes(npoints), zdata(npoints), zscale(npoints))
2371 IF (is_circular)
THEN
2377 IF (do_surface_green)
THEN
2378 CALL simpsonrule_init(sr_env, xnodes, npoints, integr_lbound, integr_ubound, &
2379 shape_id, conv_integr, matrix_s_global)
2381 CALL simpsonrule_init(sr_env, xnodes, npoints, integr_lbound, integr_ubound, &
2382 shape_id, conv_integr, matrix_s_global, tnodes_restart=g_surf_cache%tnodes)
2385 DO WHILE (npoints > 0 .AND. npoints_total < max_points)
2386 DO ipoint = 1, npoints
2390 IF (do_surface_green)
THEN
2393 IF (
PRESENT(just_contact))
THEN
2395 DO icontact = 1, ncontacts
2396 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, npoints_total + 1:), &
2397 omega=xnodes(1:npoints), &
2398 h0=negf_env%contacts(just_contact)%h_00(ispin), &
2399 s0=negf_env%contacts(just_contact)%s_00, &
2400 h1=negf_env%contacts(just_contact)%h_01(ispin), &
2401 s1=negf_env%contacts(just_contact)%s_01, &
2402 sub_env=sub_env, v_external=0.0_dp, &
2403 conv=negf_control%conv_green, transp=(icontact == 1))
2406 DO icontact = 1, ncontacts
2407 IF (.NOT. ignore_bias) v_external = negf_control%contacts(icontact)%v_external
2409 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, npoints_total + 1:), &
2410 omega=xnodes(1:npoints), &
2411 h0=negf_env%contacts(icontact)%h_00(ispin), &
2412 s0=negf_env%contacts(icontact)%s_00, &
2413 h1=negf_env%contacts(icontact)%h_01(ispin), &
2414 s1=negf_env%contacts(icontact)%s_01, &
2416 v_external=v_external, &
2417 conv=negf_control%conv_green, transp=.false.)
2422 IF (temperature >= 0.0_dp)
THEN
2423 DO ipoint = 1, npoints
2424 zscale(ipoint) = fermi_function(xnodes(ipoint) - mu_base, temperature)
2430 CALL negf_retarded_green_function_batch(omega=xnodes(1:npoints), &
2432 ignore_bias=ignore_bias, &
2433 negf_env=negf_env, &
2434 negf_control=negf_control, &
2437 g_surf_contacts=g_surf_cache%g_surf_contacts(:, npoints_total + 1:), &
2438 g_ret_s=zdata(1:npoints), &
2439 g_ret_scale=zscale(1:npoints), &
2440 just_contact=just_contact)
2442 npoints_total = npoints_total + npoints
2446 IF (sr_env%error <= conv_integr)
EXIT
2451 do_surface_green = .true.
2453 npoints = max_points - npoints_total
2454 IF (npoints <= 0)
EXIT
2455 IF (npoints >
SIZE(xnodes)) npoints =
SIZE(xnodes)
2461 stats%error = stats%error + sr_env%error/
pi
2463 CALL cp_cfm_to_fm(sr_env%integral, mtargeti=integral_imag)
2466 IF (do_surface_green)
THEN
2471 DEALLOCATE (xnodes, zdata, zscale)
2474 cpabort(
"Unimplemented integration method")
2477 stats%npoints = stats%npoints + npoints_total
2482 CALL timestop(handle)
2483 END SUBROUTINE negf_add_rho_equiv_low
2499 SUBROUTINE negf_add_rho_nonequiv(rho_ao_fm, stats, v_shift, negf_env, negf_control, sub_env, &
2500 ispin, base_contact, matrix_s_global, g_surf_cache)
2502 TYPE(integration_status_type),
INTENT(inout) :: stats
2503 REAL(kind=
dp),
INTENT(in) :: v_shift
2507 INTEGER,
INTENT(in) :: ispin, base_contact
2508 TYPE(
cp_fm_type),
INTENT(IN) :: matrix_s_global
2511 CHARACTER(LEN=*),
PARAMETER :: routinen =
'negf_add_rho_nonequiv'
2513 COMPLEX(kind=dp) :: fermi_base, fermi_contact, &
2514 integr_lbound, integr_ubound
2515 COMPLEX(kind=dp),
ALLOCATABLE,
DIMENSION(:) :: xnodes
2516 INTEGER :: handle, icontact, ipoint, jcontact, &
2517 max_points, min_points, ncontacts, &
2518 npoints, npoints_total
2519 LOGICAL :: do_surface_green
2520 REAL(kind=
dp) :: conv_density, conv_integr, eta, &
2521 ln_conv_density, mu_base, mu_contact, &
2522 temperature_base, temperature_contact
2523 TYPE(
cp_cfm_type),
ALLOCATABLE,
DIMENSION(:, :) :: zdata
2529 CALL timeset(routinen, handle)
2531 ncontacts =
SIZE(negf_env%contacts)
2532 cpassert(base_contact <= ncontacts)
2535 IF (ncontacts > 2)
THEN
2536 cpabort(
"Poisson solver does not support the general NEGF setup (>2 contacts).")
2539 mu_base = negf_control%contacts(base_contact)%fermi_level - negf_control%contacts(base_contact)%v_external
2540 min_points = negf_control%integr_min_points
2541 max_points = negf_control%integr_max_points
2542 temperature_base = negf_control%contacts(base_contact)%temperature
2543 eta = negf_control%eta
2544 conv_density = negf_control%conv_density
2545 ln_conv_density = log(conv_density)
2549 conv_integr = 0.5_dp*conv_density*
pi
2551 DO icontact = 1, ncontacts
2552 IF (icontact /= base_contact)
THEN
2553 mu_contact = negf_control%contacts(icontact)%fermi_level - negf_control%contacts(icontact)%v_external
2554 temperature_contact = negf_control%contacts(icontact)%temperature
2556 integr_lbound = cmplx(min(mu_base + ln_conv_density*temperature_base, &
2557 mu_contact + ln_conv_density*temperature_contact), eta, kind=
dp)
2558 integr_ubound = cmplx(max(mu_base - ln_conv_density*temperature_base, &
2559 mu_contact - ln_conv_density*temperature_contact), eta, kind=
dp)
2561 do_surface_green = .NOT.
ALLOCATED(g_surf_cache%tnodes)
2563 IF (do_surface_green)
THEN
2564 npoints = min_points
2566 npoints =
SIZE(g_surf_cache%tnodes)
2570 ALLOCATE (xnodes(npoints))
2571 CALL cp_fm_get_info(rho_ao_fm, para_env=para_env, matrix_struct=fm_struct)
2573 IF (do_surface_green)
THEN
2574 CALL simpsonrule_init(sr_env, xnodes, npoints, integr_lbound, integr_ubound, &
2577 CALL simpsonrule_init(sr_env, xnodes, npoints, integr_lbound, integr_ubound, &
2578 sr_shape_linear, conv_integr, matrix_s_global, tnodes_restart=g_surf_cache%tnodes)
2581 DO WHILE (npoints > 0 .AND. npoints_total < max_points)
2583 IF (do_surface_green)
THEN
2586 DO jcontact = 1, ncontacts
2587 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(jcontact, npoints_total + 1:), &
2588 omega=xnodes(1:npoints), &
2589 h0=negf_env%contacts(jcontact)%h_00(ispin), &
2590 s0=negf_env%contacts(jcontact)%s_00, &
2591 h1=negf_env%contacts(jcontact)%h_01(ispin), &
2592 s1=negf_env%contacts(jcontact)%s_01, &
2594 v_external=negf_control%contacts(jcontact)%v_external, &
2595 conv=negf_control%conv_green, transp=.false.)
2599 ALLOCATE (zdata(ncontacts, npoints))
2601 DO ipoint = 1, npoints
2606 CALL negf_retarded_green_function_batch(omega=xnodes(1:npoints), &
2608 ignore_bias=.false., &
2609 negf_env=negf_env, &
2610 negf_control=negf_control, &
2613 g_surf_contacts=g_surf_cache%g_surf_contacts(:, npoints_total + 1:), &
2614 gret_gamma_gadv=zdata(:, 1:npoints))
2616 DO ipoint = 1, npoints
2617 fermi_base = fermi_function(cmplx(real(xnodes(ipoint), kind=
dp) - mu_base, 0.0_dp, kind=
dp), &
2619 fermi_contact = fermi_function(cmplx(real(xnodes(ipoint), kind=
dp) - mu_contact, 0.0_dp, kind=
dp), &
2620 temperature_contact)
2621 CALL cp_cfm_scale(fermi_contact - fermi_base, zdata(icontact, ipoint))
2624 npoints_total = npoints_total + npoints
2628 DO ipoint = 1, npoints
2634 IF (sr_env%error <= conv_integr)
EXIT
2637 do_surface_green = .true.
2639 npoints = max_points - npoints_total
2640 IF (npoints <= 0)
EXIT
2641 IF (npoints >
SIZE(xnodes)) npoints =
SIZE(xnodes)
2649 CALL cp_cfm_to_fm(sr_env%integral, mtargetr=integral_real)
2656 stats%error = stats%error + sr_env%error*0.5_dp/
pi
2657 stats%npoints = stats%npoints + npoints_total
2660 IF (do_surface_green)
THEN
2668 CALL timestop(handle)
2669 END SUBROUTINE negf_add_rho_nonequiv
2676 ELEMENTAL SUBROUTINE integration_status_reset(stats)
2677 TYPE(integration_status_type),
INTENT(out) :: stats
2680 stats%error = 0.0_dp
2681 END SUBROUTINE integration_status_reset
2690 ELEMENTAL FUNCTION get_method_description_string(stats, integration_method)
RESULT(method_descr)
2691 TYPE(integration_status_type),
INTENT(in) :: stats
2692 INTEGER,
INTENT(in) :: integration_method
2693 CHARACTER(len=18) :: method_descr
2695 CHARACTER(len=2) :: method_abbr
2696 CHARACTER(len=6) :: npoints_str
2698 SELECT CASE (integration_method)
2709 WRITE (npoints_str,
'(I6)') stats%npoints
2710 WRITE (method_descr,
'(A2,T4,A,T11,ES8.2E2)') method_abbr, trim(adjustl(npoints_str)), stats%error
2711 END FUNCTION get_method_description_string
2726 FUNCTION negf_compute_current(contact_id1, contact_id2, v_shift, negf_env, negf_control, sub_env, ispin, &
2727 blacs_env_global)
RESULT(current)
2728 INTEGER,
INTENT(in) :: contact_id1, contact_id2
2729 REAL(kind=
dp),
INTENT(in) :: v_shift
2733 INTEGER,
INTENT(in) :: ispin
2735 REAL(kind=
dp) :: current
2737 CHARACTER(LEN=*),
PARAMETER :: routinen =
'negf_compute_current'
2738 REAL(kind=
dp),
PARAMETER :: threshold = 16.0_dp*epsilon(0.0_dp)
2740 COMPLEX(kind=dp) :: fermi_contact1, fermi_contact2, &
2741 integr_lbound, integr_ubound
2742 COMPLEX(kind=dp),
ALLOCATABLE,
DIMENSION(:) :: transm_coeff, xnodes
2743 COMPLEX(kind=dp),
DIMENSION(1, 1) :: transmission
2744 INTEGER :: handle, icontact, ipoint, max_points, &
2745 min_points, ncontacts, npoints, &
2747 REAL(kind=
dp) :: conv_density, energy, eta, ln_conv_density, mu_contact1, mu_contact2, &
2748 temperature_contact1, temperature_contact2, v_contact1, v_contact2
2749 TYPE(
cp_cfm_type),
ALLOCATABLE,
DIMENSION(:) :: zdata
2757 IF (.NOT.
ASSOCIATED(negf_env%s_s))
RETURN
2759 CALL timeset(routinen, handle)
2761 ncontacts =
SIZE(negf_env%contacts)
2762 cpassert(contact_id1 <= ncontacts)
2763 cpassert(contact_id2 <= ncontacts)
2764 cpassert(contact_id1 /= contact_id2)
2766 v_contact1 = negf_control%contacts(contact_id1)%v_external
2767 mu_contact1 = negf_control%contacts(contact_id1)%fermi_level - v_contact1
2768 v_contact2 = negf_control%contacts(contact_id2)%v_external
2769 mu_contact2 = negf_control%contacts(contact_id2)%fermi_level - v_contact2
2771 IF (abs(mu_contact1 - mu_contact2) < threshold)
THEN
2772 CALL timestop(handle)
2776 min_points = negf_control%integr_min_points
2777 max_points = negf_control%integr_max_points
2778 temperature_contact1 = negf_control%contacts(contact_id1)%temperature
2779 temperature_contact2 = negf_control%contacts(contact_id2)%temperature
2780 eta = negf_control%eta
2781 conv_density = negf_control%conv_density
2782 ln_conv_density = log(conv_density)
2784 integr_lbound = cmplx(min(mu_contact1 + ln_conv_density*temperature_contact1, &
2785 mu_contact2 + ln_conv_density*temperature_contact2), eta, kind=
dp)
2786 integr_ubound = cmplx(max(mu_contact1 - ln_conv_density*temperature_contact1, &
2787 mu_contact2 - ln_conv_density*temperature_contact2), eta, kind=
dp)
2790 npoints = min_points
2792 NULLIFY (fm_struct_single)
2793 CALL cp_fm_struct_create(fm_struct_single, nrow_global=1, ncol_global=1, context=blacs_env_global)
2797 ALLOCATE (transm_coeff(npoints), xnodes(npoints), zdata(npoints))
2799 CALL simpsonrule_init(sr_env, xnodes, npoints, integr_lbound, integr_ubound, &
2802 DO WHILE (npoints > 0 .AND. npoints_total < max_points)
2805 DO icontact = 1, ncontacts
2806 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, 1:npoints), &
2807 omega=xnodes(1:npoints), &
2808 h0=negf_env%contacts(icontact)%h_00(ispin), &
2809 s0=negf_env%contacts(icontact)%s_00, &
2810 h1=negf_env%contacts(icontact)%h_01(ispin), &
2811 s1=negf_env%contacts(icontact)%s_01, &
2813 v_external=negf_control%contacts(icontact)%v_external, &
2814 conv=negf_control%conv_green, transp=.false.)
2817 CALL negf_retarded_green_function_batch(omega=xnodes(1:npoints), &
2819 ignore_bias=.false., &
2820 negf_env=negf_env, &
2821 negf_control=negf_control, &
2824 g_surf_contacts=g_surf_cache%g_surf_contacts(:, 1:npoints), &
2825 transm_coeff=transm_coeff(1:npoints), &
2826 transm_contact1=contact_id1, &
2827 transm_contact2=contact_id2)
2829 DO ipoint = 1, npoints
2832 energy = real(xnodes(ipoint), kind=
dp)
2833 fermi_contact1 = fermi_function(cmplx(energy - mu_contact1, 0.0_dp, kind=
dp), temperature_contact1)
2834 fermi_contact2 = fermi_function(cmplx(energy - mu_contact2, 0.0_dp, kind=
dp), temperature_contact2)
2836 transmission(1, 1) = transm_coeff(ipoint)*(fermi_contact1 - fermi_contact2)
2842 npoints_total = npoints_total + npoints
2846 IF (sr_env%error <= negf_control%conv_density)
EXIT
2848 npoints = max_points - npoints_total
2849 IF (npoints <= 0)
EXIT
2850 IF (npoints >
SIZE(xnodes)) npoints =
SIZE(xnodes)
2863 DEALLOCATE (transm_coeff, xnodes, zdata)
2865 CALL timestop(handle)
2866 END FUNCTION negf_compute_current
2883 SUBROUTINE negf_print_dos(log_unit, energy_min, energy_max, npoints, v_shift, negf_env, &
2884 negf_control, sub_env, base_contact, just_contact, volume)
2885 INTEGER,
INTENT(in) :: log_unit
2886 REAL(kind=
dp),
INTENT(in) :: energy_min, energy_max
2887 INTEGER,
INTENT(in) :: npoints
2888 REAL(kind=
dp),
INTENT(in) :: v_shift
2892 INTEGER,
INTENT(in) :: base_contact
2893 INTEGER,
INTENT(in),
OPTIONAL :: just_contact
2894 REAL(kind=
dp),
INTENT(in),
OPTIONAL :: volume
2896 CHARACTER(LEN=*),
PARAMETER :: routinen =
'negf_print_dos'
2898 CHARACTER :: uks_str
2899 CHARACTER(len=15) :: units_str
2900 COMPLEX(kind=dp),
ALLOCATABLE,
DIMENSION(:) :: xnodes
2901 INTEGER :: handle, icontact, ipoint, ispin, &
2902 ncontacts, npoints_bundle, &
2903 npoints_remain, nspins
2904 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: dos
2907 CALL timeset(routinen, handle)
2909 IF (
PRESENT(just_contact))
THEN
2910 nspins =
SIZE(negf_env%contacts(just_contact)%h_00)
2912 nspins =
SIZE(negf_env%h_s)
2915 IF (log_unit > 0)
THEN
2916 IF (
PRESENT(volume))
THEN
2917 units_str =
' (angstroms^-3)'
2922 IF (nspins > 1)
THEN
2930 IF (
PRESENT(just_contact))
THEN
2931 WRITE (log_unit,
'(3A,T70,I11)')
"# Density of states", trim(units_str),
" for the contact No. ", just_contact
2933 WRITE (log_unit,
'(3A)')
"# Density of states", trim(units_str),
" for the scattering region"
2936 WRITE (log_unit,
'(A,T10,A,T43,3A)')
"#",
"Energy (a.u.)",
"Number of states [alpha ", uks_str,
" beta]"
2938 WRITE (log_unit,
'("#", T3,78("-"))')
2941 ncontacts =
SIZE(negf_env%contacts)
2942 cpassert(base_contact <= ncontacts)
2943 IF (
PRESENT(just_contact))
THEN
2945 cpassert(just_contact == base_contact)
2947 mark_used(base_contact)
2949 npoints_bundle = 4*sub_env%ngroups
2950 IF (npoints_bundle > npoints) npoints_bundle = npoints
2952 ALLOCATE (dos(npoints_bundle, nspins), xnodes(npoints_bundle))
2954 npoints_remain = npoints
2955 DO WHILE (npoints_remain > 0)
2956 IF (npoints_bundle > npoints_remain) npoints_bundle = npoints_remain
2958 IF (npoints > 1)
THEN
2959 DO ipoint = 1, npoints_bundle
2960 xnodes(ipoint) = cmplx(energy_min + real(npoints - npoints_remain + ipoint - 1, kind=
dp)/ &
2961 REAL(npoints - 1, kind=
dp)*(energy_max - energy_min), negf_control%eta, kind=
dp)
2964 xnodes(ipoint) = cmplx(energy_min, negf_control%eta, kind=
dp)
2967 DO ispin = 1, nspins
2970 IF (
PRESENT(just_contact))
THEN
2971 DO icontact = 1, ncontacts
2972 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, :), &
2973 omega=xnodes(1:npoints_bundle), &
2974 h0=negf_env%contacts(just_contact)%h_00(ispin), &
2975 s0=negf_env%contacts(just_contact)%s_00, &
2976 h1=negf_env%contacts(just_contact)%h_01(ispin), &
2977 s1=negf_env%contacts(just_contact)%s_01, &
2978 sub_env=sub_env, v_external=0.0_dp, &
2979 conv=negf_control%conv_green, transp=(icontact == 1))
2982 DO icontact = 1, ncontacts
2983 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, :), &
2984 omega=xnodes(1:npoints_bundle), &
2985 h0=negf_env%contacts(icontact)%h_00(ispin), &
2986 s0=negf_env%contacts(icontact)%s_00, &
2987 h1=negf_env%contacts(icontact)%h_01(ispin), &
2988 s1=negf_env%contacts(icontact)%s_01, &
2990 v_external=negf_control%contacts(icontact)%v_external, &
2991 conv=negf_control%conv_green, transp=.false.)
2995 CALL negf_retarded_green_function_batch(omega=xnodes(1:npoints_bundle), &
2997 ignore_bias=.false., &
2998 negf_env=negf_env, &
2999 negf_control=negf_control, &
3002 g_surf_contacts=g_surf_cache%g_surf_contacts, &
3003 dos=dos(1:npoints_bundle, ispin), &
3004 just_contact=just_contact)
3009 IF (log_unit > 0)
THEN
3010 DO ipoint = 1, npoints_bundle
3011 IF (nspins > 1)
THEN
3013 WRITE (log_unit,
'(T2,F20.8,T30,2ES25.11E3)') real(xnodes(ipoint), kind=
dp), dos(ipoint, 1), dos(ipoint, 2)
3016 WRITE (log_unit,
'(T2,F20.8,T43,ES25.11E3)') real(xnodes(ipoint), kind=
dp), 2.0_dp*dos(ipoint, 1)
3021 npoints_remain = npoints_remain - npoints_bundle
3024 DEALLOCATE (dos, xnodes)
3025 CALL timestop(handle)
3026 END SUBROUTINE negf_print_dos
3042 SUBROUTINE negf_print_transmission(log_unit, energy_min, energy_max, npoints, v_shift, negf_env, &
3043 negf_control, sub_env, contact_id1, contact_id2)
3044 INTEGER,
INTENT(in) :: log_unit
3045 REAL(kind=
dp),
INTENT(in) :: energy_min, energy_max
3046 INTEGER,
INTENT(in) :: npoints
3047 REAL(kind=
dp),
INTENT(in) :: v_shift
3051 INTEGER,
INTENT(in) :: contact_id1, contact_id2
3053 CHARACTER(LEN=*),
PARAMETER :: routinen =
'negf_print_transmission'
3055 CHARACTER :: uks_str
3056 COMPLEX(kind=dp),
ALLOCATABLE,
DIMENSION(:) :: xnodes
3057 COMPLEX(kind=dp),
ALLOCATABLE,
DIMENSION(:, :) :: transm_coeff
3058 INTEGER :: handle, icontact, ipoint, ispin, &
3059 ncontacts, npoints_bundle, &
3060 npoints_remain, nspins
3061 REAL(kind=
dp) :: rscale
3064 CALL timeset(routinen, handle)
3066 nspins =
SIZE(negf_env%h_s)
3068 IF (nspins > 1)
THEN
3076 IF (log_unit > 0)
THEN
3077 WRITE (log_unit,
'(A)')
"# Transmission coefficient (G0 = 2 e^2/h) for the scattering region"
3079 WRITE (log_unit,
'(A,T10,A,T39,3A)')
"#",
"Energy (a.u.)",
"Transmission coefficient [alpha ", uks_str,
" beta]"
3080 WRITE (log_unit,
'("#", T3,78("-"))')
3083 ncontacts =
SIZE(negf_env%contacts)
3084 cpassert(contact_id1 <= ncontacts)
3085 cpassert(contact_id2 <= ncontacts)
3087 IF (nspins == 1)
THEN
3095 rscale = 0.5_dp*rscale
3097 npoints_bundle = 4*sub_env%ngroups
3098 IF (npoints_bundle > npoints) npoints_bundle = npoints
3100 ALLOCATE (transm_coeff(npoints_bundle, nspins), xnodes(npoints_bundle))
3102 npoints_remain = npoints
3103 DO WHILE (npoints_remain > 0)
3104 IF (npoints_bundle > npoints_remain) npoints_bundle = npoints_remain
3106 IF (npoints > 1)
THEN
3107 DO ipoint = 1, npoints_bundle
3108 xnodes(ipoint) = cmplx(energy_min + real(npoints - npoints_remain + ipoint - 1, kind=
dp)/ &
3109 REAL(npoints - 1, kind=
dp)*(energy_max - energy_min), negf_control%eta, kind=
dp)
3112 xnodes(ipoint) = cmplx(energy_min, negf_control%eta, kind=
dp)
3115 DO ispin = 1, nspins
3118 DO icontact = 1, ncontacts
3119 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, :), &
3120 omega=xnodes(1:npoints_bundle), &
3121 h0=negf_env%contacts(icontact)%h_00(ispin), &
3122 s0=negf_env%contacts(icontact)%s_00, &
3123 h1=negf_env%contacts(icontact)%h_01(ispin), &
3124 s1=negf_env%contacts(icontact)%s_01, &
3126 v_external=negf_control%contacts(icontact)%v_external, &
3127 conv=negf_control%conv_green, transp=.false.)
3130 CALL negf_retarded_green_function_batch(omega=xnodes(1:npoints_bundle), &
3132 ignore_bias=.false., &
3133 negf_env=negf_env, &
3134 negf_control=negf_control, &
3137 g_surf_contacts=g_surf_cache%g_surf_contacts, &
3138 transm_coeff=transm_coeff(1:npoints_bundle, ispin), &
3139 transm_contact1=contact_id1, &
3140 transm_contact2=contact_id2)
3145 IF (log_unit > 0)
THEN
3146 DO ipoint = 1, npoints_bundle
3147 IF (nspins > 1)
THEN
3149 WRITE (log_unit,
'(T2,F20.8,T30,2ES25.11E3)') &
3150 REAL(xnodes(ipoint), kind=
dp), rscale*real(transm_coeff(ipoint, 1:2), kind=
dp)
3153 WRITE (log_unit,
'(T2,F20.8,T43,ES25.11E3)') &
3154 REAL(xnodes(ipoint), kind=
dp), rscale*real(transm_coeff(ipoint, 1), kind=
dp)
3159 npoints_remain = npoints_remain - npoints_bundle
3162 DEALLOCATE (transm_coeff, xnodes)
3163 CALL timestop(handle)
3164 END SUBROUTINE negf_print_transmission
3178 SUBROUTINE negf_output_initial(log_unit, negf_env, sub_env, negf_control, dft_control, verbose_output, &
3180 INTEGER,
INTENT(in) :: log_unit
3185 LOGICAL,
INTENT(in) :: verbose_output, debug_output
3187 CHARACTER(LEN=*),
PARAMETER :: routinen =
'negf_output_initial'
3189 CHARACTER(len=100) :: sfmt
3190 INTEGER :: handle, i, icontact, j, k, n, nrow
3191 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: target_m
3193 CALL timeset(routinen, handle)
3196 DO icontact = 1,
SIZE(negf_control%contacts)
3197 IF (log_unit > 0)
THEN
3198 WRITE (log_unit,
"(/,' The electrode',I5)") icontact
3199 WRITE (log_unit,
"( ' ------------------')")
3200 WRITE (log_unit,
"(' From the force environment:',I16)") negf_control%contacts(icontact)%force_env_index
3201 WRITE (log_unit,
"(' Number of atoms:',I27)")
SIZE(negf_control%contacts(icontact)%atomlist_bulk)
3202 IF (verbose_output)
WRITE (log_unit,
"(' Atoms belonging to a contact (from the entire system):')")
3203 IF (verbose_output)
WRITE (log_unit,
"(16I5)") negf_control%contacts(icontact)%atomlist_bulk
3204 WRITE (log_unit,
"(' Number of atoms in a primary unit cell:',I4)") &
3205 SIZE(negf_env%contacts(icontact)%atomlist_cell0)
3207 IF (log_unit > 0 .AND. verbose_output)
THEN
3208 WRITE (log_unit,
"(' Atoms belonging to a primary unit cell (from the entire system):')")
3209 WRITE (log_unit,
"(16I5)") negf_env%contacts(icontact)%atomlist_cell0
3210 WRITE (log_unit,
"(' Direction of an electrode: ',I16)") negf_env%contacts(icontact)%direction_axis
3213 IF (debug_output)
THEN
3214 CALL cp_fm_get_info(negf_env%contacts(icontact)%s_00, nrow_global=nrow)
3215 ALLOCATE (target_m(nrow, nrow))
3216 IF (log_unit > 0)
WRITE (log_unit,
"(' The number of atomic orbitals:',I13)") nrow
3217 DO k = 1, dft_control%nspins
3219 IF (log_unit > 0)
THEN
3220 WRITE (sfmt,
"('(',i0,'(E15.5))')") nrow
3221 WRITE (log_unit,
"(' The H_00 electrode Hamiltonian for spin',I2)") k
3223 WRITE (log_unit, sfmt) (target_m(i, j), j=1, nrow)
3227 IF (log_unit > 0)
THEN
3228 WRITE (log_unit,
"(' The H_01 electrode Hamiltonian for spin',I2)") k
3230 WRITE (log_unit, sfmt) (target_m(i, j), j=1, nrow)
3235 IF (log_unit > 0)
THEN
3236 WRITE (log_unit,
"(' The S_00 overlap matrix')")
3238 WRITE (log_unit, sfmt) (target_m(i, j), j=1, nrow)
3242 IF (log_unit > 0)
THEN
3243 WRITE (log_unit,
"(' The S_01 overlap matrix')")
3245 WRITE (log_unit, sfmt) (target_m(i, j), j=1, nrow)
3248 DEALLOCATE (target_m)
3253 IF (log_unit > 0)
THEN
3254 WRITE (log_unit,
"(/,' The full scattering region')")
3255 WRITE (log_unit,
"( ' --------------------------')")
3256 WRITE (log_unit,
"(' Number of atoms:',I27)")
SIZE(negf_control%atomlist_S_screening)
3257 IF (verbose_output)
WRITE (log_unit,
"(' Atoms belonging to a full scattering region:')")
3258 IF (verbose_output)
WRITE (log_unit,
"(16I5)") negf_control%atomlist_S_screening
3261 IF (debug_output)
THEN
3263 ALLOCATE (target_m(n, n))
3264 WRITE (sfmt,
"('(',i0,'(E15.5))')") n
3265 IF (log_unit > 0)
WRITE (log_unit,
"(' The number of atomic orbitals:',I14)") n
3266 DO k = 1, dft_control%nspins
3267 IF (log_unit > 0)
WRITE (log_unit,
"(' The H_s Hamiltonian for spin',I2)") k
3270 IF (log_unit > 0)
WRITE (log_unit, sfmt) (target_m(i, j), j=1, n)
3273 IF (log_unit > 0)
WRITE (log_unit,
"(' The S_s overlap matrix')")
3276 IF (log_unit > 0)
WRITE (log_unit, sfmt) (target_m(i, j), j=1, n)
3278 DEALLOCATE (target_m)
3279 IF (log_unit > 0)
WRITE (log_unit,
"(/,' Scattering region - electrode contacts')")
3280 IF (log_unit > 0)
WRITE (log_unit,
"( ' ---------------------------------------')")
3281 ALLOCATE (target_m(n, nrow))
3282 DO icontact = 1,
SIZE(negf_control%contacts)
3283 IF (log_unit > 0)
WRITE (log_unit,
"(/,' The contact',I5)") icontact
3284 IF (log_unit > 0)
WRITE (log_unit,
"( ' ----------------')")
3285 DO k = 1, dft_control%nspins
3287 IF (log_unit > 0)
THEN
3288 WRITE (log_unit,
"(' The H_sc Hamiltonian for spin',I2)") k
3290 WRITE (log_unit, sfmt) (target_m(i, j), j=1, nrow)
3295 IF (log_unit > 0)
THEN
3296 WRITE (log_unit,
"(' The S_sc overlap matrix')")
3298 WRITE (log_unit, sfmt) (target_m(i, j), j=1, nrow)
3302 DEALLOCATE (target_m)
3305 IF (log_unit > 0)
THEN
3306 WRITE (log_unit,
"(/,' NEGF| Number of MPI processes: ',I5)") sub_env%mpi_comm_global%num_pe
3307 WRITE (log_unit,
"(' NEGF| Maximal number of processes per energy point:',I5)") negf_control%nprocs
3308 WRITE (log_unit,
"(' NEGF| Number of parallel MPI (energy) groups: ',I5)") sub_env%ngroups
3311 CALL timestop(handle)
3312 END SUBROUTINE negf_output_initial
3322 SUBROUTINE negf_write_restart(filename, negf_env, negf_control)
3323 CHARACTER(LEN=*),
INTENT(IN) :: filename
3327 INTEGER :: icontact, ncontacts, print_unit
3329 CALL open_file(file_name=filename, file_status=
"REPLACE", &
3330 file_form=
"FORMATTED", file_action=
"WRITE", &
3331 file_position=
"REWIND", unit_number=print_unit)
3333 WRITE (print_unit, *)
'This file is created automatically with restart files.'
3334 WRITE (print_unit, *)
'Do not remove it if you use any of restart files!'
3336 ncontacts =
SIZE(negf_control%contacts)
3338 DO icontact = 1, ncontacts
3339 WRITE (print_unit, *)
'icontact', icontact,
' fermi_energy', negf_env%contacts(icontact)%fermi_energy
3340 WRITE (print_unit, *)
'icontact', icontact,
' nelectrons_qs_cell0', negf_env%contacts(icontact)%nelectrons_qs_cell0
3341 WRITE (print_unit, *)
'icontact', icontact,
' nelectrons_qs_cell1', negf_env%contacts(icontact)%nelectrons_qs_cell1
3344 WRITE (print_unit, *)
'nelectrons_ref', negf_env%nelectrons_ref
3345 WRITE (print_unit, *)
'nelectrons ', negf_env%nelectrons
3349 END SUBROUTINE negf_write_restart
3359 SUBROUTINE negf_read_restart(filename, negf_env, negf_control)
3360 CHARACTER(LEN=*),
INTENT(IN) :: filename
3365 INTEGER :: i, icontact, ncontacts, print_unit
3367 CALL open_file(file_name=filename, file_status=
"OLD", &
3368 file_form=
"FORMATTED", file_action=
"READ", &
3369 file_position=
"REWIND", unit_number=print_unit)
3371 READ (print_unit, *) a
3372 READ (print_unit, *) a
3374 ncontacts =
SIZE(negf_control%contacts)
3376 DO icontact = 1, ncontacts
3377 READ (print_unit, *) a, i, a, negf_env%contacts(icontact)%fermi_energy
3378 READ (print_unit, *) a, i, a, negf_env%contacts(icontact)%nelectrons_qs_cell0
3379 READ (print_unit, *) a, i, a, negf_env%contacts(icontact)%nelectrons_qs_cell1
3382 READ (print_unit, *) a, negf_env%nelectrons_ref
3383 READ (print_unit, *) a, negf_env%nelectrons
3387 END SUBROUTINE negf_read_restart
collects all references to literature in CP2K as new algorithms / method are included from literature...
integer, save, public papior2017
integer, save, public bailey2006
methods related to the blacs parallel environment
Basic linear algebra operations for complex full matrices.
subroutine, public cp_cfm_scale_and_add(alpha, matrix_a, beta, matrix_b)
Scale and add two BLACS matrices (a = alpha*a + beta*b).
subroutine, public cp_cfm_trace(matrix_a, matrix_b, trace)
Returns the trace of matrix_a^T matrix_b, i.e sum_{i,j}(matrix_a(i,j)*matrix_b(i,j)) .
Represents a complex full matrix distributed on many processors.
subroutine, public cp_cfm_get_submatrix(fm, target_m, start_row, start_col, n_rows, n_cols, transpose)
Extract a sub-matrix from the full matrix: op(target_m)(1:n_rows,1:n_cols) = fm(start_row:start_row+n...
subroutine, public cp_cfm_release(matrix)
Releases a full matrix.
subroutine, public cp_cfm_start_copy_general(source, destination, para_env, info)
Initiate the copy operation: get distribution data, post MPI isend and irecvs.
subroutine, public cp_cfm_create(matrix, matrix_struct, name, nrow, ncol, set_zero)
Creates a new full matrix with the given structure.
subroutine, public cp_cfm_cleanup_copy_general(info)
Complete the copy operation: wait for comms clean up MPI state.
subroutine, public cp_cfm_get_info(matrix, name, nrow_global, ncol_global, nrow_block, ncol_block, nrow_local, ncol_local, row_indices, col_indices, local_data, context, matrix_struct, para_env)
Returns information about a full matrix.
subroutine, public cp_cfm_set_submatrix(matrix, new_values, start_row, start_col, n_rows, n_cols, alpha, beta, transpose)
Set a sub-matrix of the full matrix: matrix(start_row:start_row+n_rows,start_col:start_col+n_cols) = ...
subroutine, public cp_cfm_to_fm(msource, mtargetr, mtargeti)
Copy real and imaginary parts of a complex full matrix into separate real-value full matrices.
subroutine, public cp_cfm_finish_copy_general(destination, info)
Complete the copy operation: wait for comms, unpack, clean up MPI state.
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
subroutine, public dbcsr_deallocate_matrix(matrix)
...
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
subroutine, public dbcsr_init_p(matrix)
...
subroutine, public dbcsr_dot(matrix_a, matrix_b, trace)
Computes the dot product of two matrices, also known as the trace of their matrix product.
DBCSR operations in CP2K.
Utility routines to open and close files. Tracking of preconnections.
subroutine, public open_file(file_name, file_status, file_form, file_action, file_position, file_pad, unit_number, debug, skip_get_unit_number, file_access)
Opens the requested file using a free unit number.
subroutine, public close_file(unit_number, file_status, keep_preconnection)
Close an open file given by its logical unit number. Optionally, keep the file and unit preconnected.
Basic linear algebra operations for full matrices.
subroutine, public cp_fm_scale_and_add(alpha, matrix_a, beta, matrix_b)
calc A <- alpha*A + beta*B optimized for alpha == 1.0 (just add beta*B) and beta == 0....
subroutine, public cp_fm_scale(alpha, matrix_a)
scales a matrix matrix_a = alpha * matrix_b
represent the structure of a full matrix
subroutine, public cp_fm_struct_create(fmstruct, para_env, context, nrow_global, ncol_global, nrow_block, ncol_block, descriptor, first_p_pos, local_leading_dimension, template_fmstruct, square_blocks, force_block)
allocates and initializes a full matrix structure
subroutine, public cp_fm_struct_release(fmstruct)
releases a full matrix structure
represent a full matrix distributed on many processors
subroutine, public cp_fm_copy_general(source, destination, para_env)
General copy of a fm matrix to another fm matrix. Uses non-blocking MPI rather than ScaLAPACK.
subroutine, public cp_fm_get_info(matrix, name, nrow_global, ncol_global, nrow_block, ncol_block, nrow_local, ncol_local, row_indices, col_indices, local_data, context, nrow_locals, ncol_locals, matrix_struct, para_env)
returns all kind of information about the full matrix
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp, nrow, ncol, set_zero)
creates a new full matrix with the given structure
subroutine, public cp_fm_add_to_element(matrix, irow_global, icol_global, alpha)
...
subroutine, public cp_fm_set_all(matrix, alpha, beta)
set all elements of a matrix to the same value, and optionally the diagonal to a different one
subroutine, public cp_fm_get_submatrix(fm, target_m, start_row, start_col, n_rows, n_cols, transpose)
gets a submatrix of a full matrix op(target_m)(1:n_rows,1:n_cols) =fm(start_row:start_row+n_rows,...
various routines to log and control the output. The idea is that decisions about where to log should ...
integer function, public cp_logger_get_default_io_unit(logger)
returns the unit nr for the ionode (-1 on all other processors) skips as well checks if the procs cal...
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
integer, parameter, public debug_print_level
integer function, public cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, middle_name, local, log_filename, ignore_should_output, file_form, file_position, file_action, file_status, do_backup, on_file, is_new_file, mpi_io, fout)
...
subroutine, public cp_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, on_file, mpi_io)
should be called after you finish working with a unit obtained with cp_print_key_unit_nr,...
integer, parameter, public cp_p_file
integer, parameter, public high_print_level
integer function, public cp_print_key_should_output(iteration_info, basis_section, print_key_path, used_print_key, first_time)
returns what should be done with the given property if btest(res,cp_p_store) then the property should...
types that represent a subsys, i.e. a part of the system
Interface for the force calculations.
recursive subroutine, public force_env_get(force_env, in_use, fist_env, qs_env, meta_env, fp_env, subsys, para_env, potential_energy, additional_potential, kinetic_energy, harmonic_shell, kinetic_shell, cell, sub_force_env, qmmm_env, qmmmx_env, eip_env, pwdft_env, globenv, input, force_env_section, method_name_id, root_section, mixed_env, nnp_env, embed_env, ipi_env)
returns various attributes about the force environment
Define type storing the global information of a run. Keep the amount of stored data small....
Defines the basic variable types.
integer, parameter, public dp
integer, parameter, public default_string_length
Types and basic routines needed for a kpoint calculation.
subroutine, public get_kpoint_info(kpoint, kp_scheme, nkp_grid, kp_shift, symmetry, verbose, full_grid, use_real_wfn, eps_geo, parallel_group_size, kp_range, nkp, xkp, wkp, para_env, blacs_env_all, para_env_kp, para_env_inter_kp, blacs_env, kp_env, kp_aux_env, mpools, iogrp, nkp_groups, kp_dist, cell_to_index, index_to_cell, sab_nl, sab_nl_nosym)
Retrieve information from a kpoint environment.
Machine interface based on Fortran 2003 and POSIX.
real(kind=dp) function, public m_walltime()
returns time from a real-time clock, protected against rolling early/easily
Definition of mathematical constants and functions.
real(kind=dp), parameter, public pi
complex(kind=dp), parameter, public z_one
real(kind=dp), parameter, public twopi
complex(kind=dp), parameter, public z_zero
Interface to the message passing library MPI.
Input control types for NEGF based quantum transport calculations.
subroutine, public negf_control_create(negf_control)
allocate control options for Non-equilibrium Green's Function calculation
subroutine, public read_negf_control(negf_control, input, subsys)
Read NEGF input parameters.
subroutine, public negf_control_release(negf_control)
release memory allocated for NEGF control options
Environment for NEGF based quantum transport calculations.
subroutine, public negf_env_release(negf_env)
Release a NEGF environment variable.
subroutine, public negf_env_create(negf_env, sub_env, negf_control, force_env, negf_mixing_section, log_unit)
Create a new NEGF environment and compute the relevant Kohn-Sham matrices.
Storage to keep precomputed surface Green's functions.
subroutine, public green_functions_cache_reorder(cache, tnodes)
Sort cached items in ascending order.
subroutine, public green_functions_cache_release(cache)
Release storage.
subroutine, public green_functions_cache_expand(cache, ncontacts, nnodes_extra)
Reallocate storage so it can handle extra 'nnodes_extra' items for each contact.
Subroutines to compute Green functions.
subroutine, public sancho_work_matrices_create(work, fm_struct)
Create work matrices required for the Lopez-Sancho algorithm.
subroutine, public sancho_work_matrices_release(work)
Release work matrices.
subroutine, public negf_contact_self_energy(self_energy_c, omega, g_surf_c, h_sc0, s_sc0, zwork1, zwork2, transp)
Compute the contact self energy at point 'omega' as self_energy_C = [omega * S_SC0 - KS_SC0] * g_surf...
subroutine, public negf_contact_broadening_matrix(gamma_c, self_energy_c)
Compute contact broadening matrix as gamma_C = i (self_energy_c^{ret.} - (self_energy_c^{ret....
subroutine, public do_sancho(g_surf, omega, h0, s0, h1, s1, conv, transp, work)
Iterative method to compute a retarded surface Green's function at the point omega.
subroutine, public negf_retarded_green_function(g_ret_s, omega, self_energy_ret_sum, h_s, s_s, v_hartree_s)
Compute the retarded Green's function at point 'omega' as G_S^{ret.} = [ omega * S_S - KS_S - \sum_{c...
Adaptive Clenshaw-Curtis quadrature algorithm to integrate a complex-valued function in a complex pla...
integer, parameter, public cc_shape_linear
subroutine, public ccquad_refine_integral(cc_env)
Refine approximated integral.
integer, parameter, public cc_interval_full
subroutine, public ccquad_double_number_of_points(cc_env, xnodes_next)
Get the next set of points at which the integrand needs to be computed. These points are then can be ...
subroutine, public ccquad_release(cc_env)
Release a Clenshaw-Curtis quadrature environment variable.
integer, parameter, public cc_interval_half
subroutine, public ccquad_init(cc_env, xnodes, nnodes, a, b, interval_id, shape_id, weights, tnodes_restart)
Initialise a Clenshaw-Curtis quadrature environment variable.
integer, parameter, public cc_shape_arc
subroutine, public ccquad_reduce_and_append_zdata(cc_env, zdata_next)
Prepare Clenshaw-Curtis environment for the subsequent refinement of the integral.
Adaptive Simpson's rule algorithm to integrate a complex-valued function in a complex plane.
integer, parameter, public sr_shape_arc
subroutine, public simpsonrule_refine_integral(sr_env, zdata_next)
Compute integral using the simpson's rules.
subroutine, public simpsonrule_init(sr_env, xnodes, nnodes, a, b, shape_id, conv, weights, tnodes_restart)
Initialise a Simpson's rule environment variable.
subroutine, public simpsonrule_release(sr_env)
Release a Simpson's rule environment variable.
integer, parameter, public sr_shape_linear
subroutine, public simpsonrule_get_next_nodes(sr_env, xnodes_next, nnodes)
Get the next set of nodes where to compute integrand.
Helper routines to manipulate with matrices.
subroutine, public invert_cell_to_index(cell_to_index, nimages, index_to_cell)
Invert cell_to_index mapping between unit cells and DBCSR matrix images.
subroutine, public negf_copy_fm_submat_to_dbcsr(fm, matrix, atomlist_row, atomlist_col, subsys)
Populate relevant blocks of the DBCSR matrix using data from a ScaLAPACK matrix. Irrelevant blocks of...
subroutine, public negf_copy_sym_dbcsr_to_fm_submat(matrix, fm, atomlist_row, atomlist_col, subsys, mpi_comm_global, do_upper_diag, do_lower)
Extract part of the DBCSR matrix based on selected atoms and copy it into a dense matrix.
NEGF based quantum transport calculations.
subroutine, public do_negf(force_env)
Perform NEGF calculation.
Environment for NEGF based quantum transport calculations.
subroutine, public negf_sub_env_release(sub_env)
Release a parallel (sub)group environment.
subroutine, public negf_sub_env_create(sub_env, negf_control, blacs_env_global, blacs_grid_layout, blacs_repeatable)
Split MPI communicator to create a set of parallel (sub)groups.
basic linear algebra operations for full matrixes
Definition of physical constants:
real(kind=dp), parameter, public e_charge
real(kind=dp), parameter, public kelvin
real(kind=dp), parameter, public seconds
real(kind=dp), parameter, public evolt
module that contains the definitions of the scf types
integer, parameter, public direct_mixing_nr
integer, parameter, public gspace_mixing_nr
Perform a QUICKSTEP wavefunction optimization (single point)
subroutine, public qs_energies(qs_env, consistent_energies, calc_forces)
Driver routine for QUICKSTEP single point wavefunction optimization.
subroutine, public get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, cell_ref, use_ref_cell, kpoints, dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, mimic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, sab_cneo, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, xcint_weights, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, rhoz_cneo_set, ecoul_1c, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, harris_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, wanniercentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Get the QUICKSTEP environment.
subroutine, public gspace_mixing(qs_env, mixing_method, mixing_store, rho, para_env, iter_count)
Driver for the g-space mixing, calls the proper routine given the requested method.
routines that build the Kohn-Sham matrix (i.e calculate the coulomb and xc parts
subroutine, public qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces, just_energy, print_active, ext_ks_matrix, ext_xc_section)
routine where the real calculations are made: the KS matrix is calculated
subroutine, public mixing_init(mixing_method, rho, mixing_store, para_env, rho_atom)
initialiation needed when gspace mixing is used
subroutine, public mixing_allocate(qs_env, mixing_method, p_mix_new, p_delta, nspins, mixing_store)
allocation needed when density mixing is used
methods of the rho structure (defined in qs_rho_types)
subroutine, public qs_rho_update_rho(rho_struct, qs_env, rho_xc_external, local_rho_set, task_list_external, task_list_external_soft, pw_env_external, para_env_external)
updates rho_r and rho_g to the rhorho_ao. if use_kinetic_energy_density also computes tau_r and tau_g...
superstucture that hold various representations of the density and keeps track of which ones are vali...
subroutine, public qs_rho_get(rho_struct, rho_ao, rho_ao_im, rho_ao_kp, rho_ao_im_kp, rho_r, drho_r, rho_g, drho_g, tau_r, tau_g, rho_r_valid, drho_r_valid, rho_g_valid, drho_g_valid, tau_r_valid, tau_g_valid, tot_rho_r, tot_rho_g, rho_r_sccs, soft_valid, complex_rho_ao)
returns info about the density described by this object. If some representation is not available an e...
groups fairly general SCF methods, so that modules other than qs_scf can use them too split off from ...
subroutine, public scf_env_density_mixing(p_mix_new, mixing_store, rho_ao, para_env, iter_delta, iter_count, diis, invert)
perform (if requested) a density mixing
types that represent a quickstep subsys
Utilities for string manipulations.
subroutine, public integer_to_string(inumber, string)
Converts an integer number to a string. The WRITE statement will return an error message,...
represent a blacs multidimensional parallel environment (for the mpi corrispective see cp_paratypes/m...
Stores the state of a copy between cp_cfm_start_copy_general and cp_cfm_finish_copy_general.
Represent a complex full matrix.
keeps the information about the structure of a full matrix
type of a logger, at the moment it contains just a print level starting at which level it should be l...
represents a system: atoms, molecules, their pos,vel,...
allows for the creation of an array of force_env
wrapper to abstract the force evaluation of the various methods
contains the initially parsed file and the initial parallel environment
Contains information about kpoints.
stores all the informations relevant to an mpi environment
Input parameters related to the NEGF run.
Storage to keep surface Green's functions.
Adaptive Clenshaw-Curtis environment.
A structure to store data needed for adaptive Simpson's rule algorithm.
Parallel (sub)group environment.
keeps the density in various representations, keeping track of which ones are valid.