49 USE dbcsr_api,
ONLY: dbcsr_copy,&
50 dbcsr_deallocate_matrix,&
83 green_functions_cache_type
90 sancho_work_matrices_type
107 negf_subgroup_env_type
127 #include "./base/base_uses.f90"
132 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'negf_methods'
133 LOGICAL,
PARAMETER,
PRIVATE :: debug_this_module = .true.
142 TYPE integration_status_type
144 REAL(kind=
dp) :: error
145 END TYPE integration_status_type
156 TYPE(force_env_type),
POINTER :: force_env
158 CHARACTER(LEN=*),
PARAMETER :: routinen =
'do_negf'
160 CHARACTER(len=default_string_length) :: contact_id_str
161 INTEGER :: handle, icontact, ispin, log_unit, &
162 ncontacts, npoints, nspins, &
163 print_level, print_unit
164 LOGICAL :: should_output, verbose_output
165 REAL(kind=
dp) :: energy_max, energy_min
166 REAL(kind=
dp),
DIMENSION(2) :: current
167 TYPE(cp_blacs_env_type),
POINTER :: blacs_env
168 TYPE(cp_logger_type),
POINTER :: logger
169 TYPE(cp_subsys_type),
POINTER :: cp_subsys
170 TYPE(dft_control_type),
POINTER :: dft_control
171 TYPE(force_env_p_type),
DIMENSION(:),
POINTER :: sub_force_env
172 TYPE(global_environment_type),
POINTER :: global_env
173 TYPE(negf_control_type),
POINTER :: negf_control
174 TYPE(negf_env_type) :: negf_env
175 TYPE(negf_subgroup_env_type) :: sub_env
176 TYPE(qs_environment_type),
POINTER :: qs_env
177 TYPE(section_vals_type),
POINTER :: negf_contact_section, &
178 negf_mixing_section, negf_section, &
179 print_section, root_section
181 CALL timeset(routinen, handle)
188 NULLIFY (blacs_env, cp_subsys, global_env, qs_env, root_section, sub_force_env)
189 CALL force_env_get(force_env, globenv=global_env, qs_env=qs_env, root_section=root_section, &
190 sub_force_env=sub_force_env, subsys=cp_subsys)
198 NULLIFY (negf_control)
203 log_unit =
cp_print_key_unit_nr(logger, negf_section,
"PRINT%PROGRAM_RUN_INFO", extension=
".Log")
206 IF (log_unit > 0)
THEN
207 CALL section_vals_val_get(negf_section,
"PRINT%PROGRAM_RUN_INFO%PRINT_LEVEL", i_val=print_level)
208 SELECT CASE (print_level)
210 verbose_output = .true.
212 verbose_output = .false.
216 IF (log_unit > 0)
THEN
217 WRITE (log_unit,
'(/,T2,A,T62)')
"COMPUTE THE RELEVANT HAMILTONIAN MATRICES"
220 CALL negf_sub_env_create(sub_env, negf_control, blacs_env, global_env%blacs_grid_layout, global_env%blacs_repeatable)
221 CALL negf_env_create(negf_env, sub_env, negf_control, force_env, negf_mixing_section, log_unit)
223 IF (log_unit > 0 .AND. verbose_output)
THEN
224 DO icontact = 1,
SIZE(negf_control%contacts)
225 WRITE (log_unit,
"(/,' NEGF| Atoms in the contact region',I2,':',I4)") &
226 icontact,
SIZE(negf_control%contacts(icontact)%atomlist_bulk)
227 WRITE (log_unit,
"(16I5)") negf_control%contacts(icontact)%atomlist_bulk
229 WRITE (log_unit,
"(/,' NEGF| Atoms in the full scattering region:',I4)")
SIZE(negf_control%atomlist_S_screening)
230 WRITE (log_unit,
"(16I5)") negf_control%atomlist_S_screening
235 ncontacts =
SIZE(negf_control%contacts)
236 DO icontact = 1, ncontacts
238 IF (negf_control%contacts(icontact)%force_env_index > 0)
THEN
239 CALL force_env_get(sub_force_env(negf_control%contacts(icontact)%force_env_index)%force_env, qs_env=qs_env)
243 CALL guess_fermi_level(icontact, negf_env, negf_control, sub_env, qs_env, log_unit)
248 IF (should_output)
THEN
256 middle_name=trim(adjustl(contact_id_str)), &
257 file_status=
"REPLACE")
259 CALL negf_print_dos(print_unit, energy_min, energy_max, npoints, &
260 v_shift=0.0_dp, negf_env=negf_env, negf_control=negf_control, &
261 sub_env=sub_env, base_contact=icontact, just_contact=icontact)
267 IF (ncontacts > 1)
THEN
270 CALL shift_potential(negf_env, negf_control, sub_env, qs_env, base_contact=1, log_unit=log_unit)
272 CALL converge_density(negf_env, negf_control, sub_env, qs_env, negf_control%v_shift, base_contact=1, log_unit=log_unit)
275 CALL get_qs_env(qs_env, dft_control=dft_control)
277 nspins = dft_control%nspins
279 cpassert(nspins <= 2)
285 current(ispin) = negf_compute_current(contact_id1=1, contact_id2=2, &
286 v_shift=negf_control%v_shift, &
288 negf_control=negf_control, &
291 blacs_env_global=blacs_env)
294 IF (log_unit > 0)
THEN
296 WRITE (log_unit,
'(/,T2,A,T60,ES20.7E2)')
"NEGF| Alpha-spin electric current (A)", current(1)
297 WRITE (log_unit,
'(T2,A,T60,ES20.7E2)')
"NEGF| Beta-spin electric current (A)", current(2)
299 WRITE (log_unit,
'(/,T2,A,T60,ES20.7E2)')
"NEGF| Electric current (A)", 2.0_dp*current(1)
307 IF (should_output)
THEN
315 middle_name=trim(adjustl(contact_id_str)), &
316 file_status=
"REPLACE")
318 CALL negf_print_dos(print_unit, energy_min, energy_max, npoints, negf_control%v_shift, &
319 negf_env=negf_env, negf_control=negf_control, &
320 sub_env=sub_env, base_contact=1)
328 IF (should_output)
THEN
335 extension=
".transm", &
336 middle_name=trim(adjustl(contact_id_str)), &
337 file_status=
"REPLACE")
339 CALL negf_print_transmission(print_unit, energy_min, energy_max, npoints, negf_control%v_shift, &
340 negf_env=negf_env, negf_control=negf_control, &
341 sub_env=sub_env, contact_id1=1, contact_id2=2)
352 CALL timestop(handle)
366 SUBROUTINE guess_fermi_level(contact_id, negf_env, negf_control, sub_env, qs_env, log_unit)
367 INTEGER,
INTENT(in) :: contact_id
368 TYPE(negf_env_type),
INTENT(in) :: negf_env
369 TYPE(negf_control_type),
POINTER :: negf_control
370 TYPE(negf_subgroup_env_type),
INTENT(in) :: sub_env
371 TYPE(qs_environment_type),
POINTER :: qs_env
372 INTEGER,
INTENT(in) :: log_unit
374 CHARACTER(LEN=*),
PARAMETER :: routinen =
'guess_fermi_level'
375 TYPE(cp_fm_type),
PARAMETER :: fm_dummy = cp_fm_type()
377 CHARACTER(len=default_string_length) :: temperature_str
378 COMPLEX(kind=dp) :: lbound_cpath, lbound_lpath, ubound_lpath
379 INTEGER :: direction_axis_abs, handle, image, &
380 ispin, nao, nimages, nspins, step
381 INTEGER,
ALLOCATABLE,
DIMENSION(:, :) :: index_to_cell
382 INTEGER,
DIMENSION(:, :, :),
POINTER :: cell_to_index
383 LOGICAL :: do_kpoints
384 REAL(kind=
dp) :: delta_au, energy_ubound_minus_fermi, fermi_level_guess, fermi_level_max, &
385 fermi_level_min, nelectrons_guess, nelectrons_max, nelectrons_min, nelectrons_qs_cell0, &
386 nelectrons_qs_cell1, offset_au, rscale, t1, t2, trace
387 TYPE(cp_blacs_env_type),
POINTER :: blacs_env_global
388 TYPE(cp_fm_struct_type),
POINTER :: fm_struct
389 TYPE(cp_fm_type) :: rho_ao_fm
390 TYPE(cp_fm_type),
POINTER :: matrix_s_fm
391 TYPE(dbcsr_p_type),
DIMENSION(:, :),
POINTER :: matrix_s_kp, rho_ao_qs_kp
392 TYPE(dft_control_type),
POINTER :: dft_control
393 TYPE(green_functions_cache_type) :: g_surf_cache
394 TYPE(integration_status_type) :: stats
395 TYPE(kpoint_type),
POINTER :: kpoints
396 TYPE(mp_para_env_type),
POINTER :: para_env_global
397 TYPE(qs_rho_type),
POINTER :: rho_struct
398 TYPE(qs_subsys_type),
POINTER :: subsys
400 CALL timeset(routinen, handle)
402 IF (negf_control%contacts(contact_id)%compute_fermi_level)
THEN
404 blacs_env=blacs_env_global, &
405 dft_control=dft_control, &
406 do_kpoints=do_kpoints, &
408 matrix_s_kp=matrix_s_kp, &
409 para_env=para_env_global, &
410 rho=rho_struct, subsys=subsys)
411 CALL qs_rho_get(rho_struct, rho_ao_kp=rho_ao_qs_kp)
413 nimages = dft_control%nimages
414 nspins = dft_control%nspins
415 direction_axis_abs = abs(negf_env%contacts(contact_id)%direction_axis)
417 cpassert(
SIZE(negf_env%contacts(contact_id)%h_00) == nspins)
419 IF (sub_env%ngroups > 1)
THEN
420 NULLIFY (matrix_s_fm, fm_struct)
422 CALL cp_fm_get_info(negf_env%contacts(contact_id)%s_00, nrow_global=nao)
423 CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nao, context=blacs_env_global)
426 ALLOCATE (matrix_s_fm)
430 IF (sub_env%group_distribution(sub_env%mepos_global) == 0)
THEN
431 CALL cp_fm_copy_general(negf_env%contacts(contact_id)%s_00, matrix_s_fm, para_env_global)
436 matrix_s_fm => negf_env%contacts(contact_id)%s_00
444 ALLOCATE (cell_to_index(0:0, 0:0, 0:0))
445 cell_to_index(0, 0, 0) = 1
448 ALLOCATE (index_to_cell(3, nimages))
450 IF (.NOT. do_kpoints)
DEALLOCATE (cell_to_index)
452 IF (nspins == 1)
THEN
460 nelectrons_qs_cell0 = 0.0_dp
461 nelectrons_qs_cell1 = 0.0_dp
462 DO image = 1, nimages
463 IF (index_to_cell(direction_axis_abs, image) == 0)
THEN
465 CALL dbcsr_dot(rho_ao_qs_kp(ispin, image)%matrix, matrix_s_kp(1, image)%matrix, trace)
466 nelectrons_qs_cell0 = nelectrons_qs_cell0 + trace
468 ELSE IF (abs(index_to_cell(direction_axis_abs, image)) == 1)
THEN
470 CALL dbcsr_dot(rho_ao_qs_kp(ispin, image)%matrix, matrix_s_kp(1, image)%matrix, trace)
471 nelectrons_qs_cell1 = nelectrons_qs_cell1 + trace
475 DEALLOCATE (index_to_cell)
477 IF (log_unit > 0)
THEN
478 WRITE (temperature_str,
'(F11.3)') negf_control%contacts(contact_id)%temperature*
kelvin
479 WRITE (log_unit,
'(/,T2,A,I0,A)')
"COMPUTE FERMI LEVEL OF CONTACT ", &
480 contact_id,
" AT "//trim(adjustl(temperature_str))//
" KELVIN"
481 WRITE (log_unit,
'(/,T2,A,T60,F20.10,/)')
"Electronic density of the isolated contact unit cell:", &
482 -1.0_dp*(nelectrons_qs_cell0 + nelectrons_qs_cell1)
483 WRITE (log_unit,
'(T3,A)')
"Step Integration method Time Fermi level Convergence (density)"
484 WRITE (log_unit,
'(T3,78("-"))')
487 nelectrons_qs_cell0 = 0.0_dp
489 CALL cp_fm_trace(negf_env%contacts(contact_id)%rho_00(ispin), &
490 negf_env%contacts(contact_id)%s_00, trace)
491 nelectrons_qs_cell0 = nelectrons_qs_cell0 + trace
496 IF (negf_control%homo_lumo_gap > 0.0_dp)
THEN
497 IF (negf_control%contacts(contact_id)%refine_fermi_level)
THEN
498 fermi_level_min = negf_control%contacts(contact_id)%fermi_level
500 fermi_level_min = negf_env%contacts(contact_id)%homo_energy
502 fermi_level_max = fermi_level_min + negf_control%homo_lumo_gap
504 IF (negf_control%contacts(contact_id)%refine_fermi_level)
THEN
505 fermi_level_max = negf_control%contacts(contact_id)%fermi_level
507 fermi_level_max = negf_env%contacts(contact_id)%homo_energy
509 fermi_level_min = fermi_level_max + negf_control%homo_lumo_gap
513 lbound_cpath = cmplx(negf_control%energy_lbound, negf_control%eta, kind=
dp)
514 delta_au = real(negf_control%delta_npoles, kind=
dp)*
twopi*negf_control%contacts(contact_id)%temperature
515 offset_au = real(negf_control%gamma_kT, kind=
dp)*negf_control%contacts(contact_id)%temperature
516 energy_ubound_minus_fermi = -2.0_dp*log(negf_control%conv_density)*negf_control%contacts(contact_id)%temperature
524 fermi_level_guess = fermi_level_min
526 fermi_level_guess = fermi_level_max
528 fermi_level_guess = fermi_level_min - (nelectrons_min - nelectrons_qs_cell0)* &
529 (fermi_level_max - fermi_level_min)/(nelectrons_max - nelectrons_min)
532 negf_control%contacts(contact_id)%fermi_level = fermi_level_guess
533 nelectrons_guess = 0.0_dp
535 lbound_lpath = cmplx(fermi_level_guess - offset_au, delta_au, kind=
dp)
536 ubound_lpath = cmplx(fermi_level_guess + energy_ubound_minus_fermi, delta_au, kind=
dp)
538 CALL integration_status_reset(stats)
541 CALL negf_init_rho_equiv_residuals(rho_ao_fm=rho_ao_fm, &
543 ignore_bias=.true., &
545 negf_control=negf_control, &
548 base_contact=contact_id, &
549 just_contact=contact_id)
551 CALL negf_add_rho_equiv_low(rho_ao_fm=rho_ao_fm, &
554 ignore_bias=.true., &
556 negf_control=negf_control, &
559 base_contact=contact_id, &
560 integr_lbound=lbound_cpath, &
561 integr_ubound=lbound_lpath, &
562 matrix_s_global=matrix_s_fm, &
563 is_circular=.true., &
564 g_surf_cache=g_surf_cache, &
565 just_contact=contact_id)
568 CALL negf_add_rho_equiv_low(rho_ao_fm=rho_ao_fm, &
571 ignore_bias=.true., &
573 negf_control=negf_control, &
576 base_contact=contact_id, &
577 integr_lbound=lbound_lpath, &
578 integr_ubound=ubound_lpath, &
579 matrix_s_global=matrix_s_fm, &
580 is_circular=.false., &
581 g_surf_cache=g_surf_cache, &
582 just_contact=contact_id)
585 CALL cp_fm_trace(rho_ao_fm, matrix_s_fm, trace)
586 nelectrons_guess = nelectrons_guess + trace
588 nelectrons_guess = nelectrons_guess*rscale
592 IF (log_unit > 0)
THEN
593 WRITE (log_unit,
'(T2,I5,T12,A,T32,F8.1,T42,F15.8,T60,ES20.5E2)') &
594 step, get_method_description_string(stats, negf_control%integr_method), &
595 t2 - t1, fermi_level_guess, nelectrons_guess - nelectrons_qs_cell0
598 IF (abs(nelectrons_qs_cell0 - nelectrons_guess) < negf_control%conv_density)
EXIT
602 nelectrons_min = nelectrons_guess
604 nelectrons_max = nelectrons_guess
606 IF (fermi_level_guess < fermi_level_min)
THEN
607 fermi_level_max = fermi_level_min
608 nelectrons_max = nelectrons_min
609 fermi_level_min = fermi_level_guess
610 nelectrons_min = nelectrons_guess
611 ELSE IF (fermi_level_guess > fermi_level_max)
THEN
612 fermi_level_min = fermi_level_max
613 nelectrons_min = nelectrons_max
614 fermi_level_max = fermi_level_guess
615 nelectrons_max = nelectrons_guess
616 ELSE IF (fermi_level_max - fermi_level_guess < fermi_level_guess - fermi_level_min)
THEN
617 fermi_level_max = fermi_level_guess
618 nelectrons_max = nelectrons_guess
620 fermi_level_min = fermi_level_guess
621 nelectrons_min = nelectrons_guess
628 negf_control%contacts(contact_id)%fermi_level = fermi_level_guess
630 IF (sub_env%ngroups > 1)
THEN
631 CALL cp_fm_release(matrix_s_fm)
632 DEALLOCATE (matrix_s_fm)
634 CALL cp_fm_release(rho_ao_fm)
637 IF (log_unit > 0)
THEN
638 WRITE (temperature_str,
'(F11.3)') negf_control%contacts(contact_id)%temperature*
kelvin
639 WRITE (log_unit,
'(/,T2,A,I0)')
"NEGF| Contact No. ", contact_id
640 WRITE (log_unit,
'(T2,A,T62,F18.8)')
"NEGF| Fermi level at "//trim(adjustl(temperature_str))// &
641 " Kelvin (a.u.):", negf_control%contacts(contact_id)%fermi_level
642 WRITE (log_unit,
'(T2,A,T62,F18.8)')
"NEGF| Electric potential (V):", &
643 negf_control%contacts(contact_id)%v_external*
evolt
646 CALL timestop(handle)
647 END SUBROUTINE guess_fermi_level
658 SUBROUTINE shift_potential(negf_env, negf_control, sub_env, qs_env, base_contact, log_unit)
659 TYPE(negf_env_type),
INTENT(in) :: negf_env
660 TYPE(negf_control_type),
POINTER :: negf_control
661 TYPE(negf_subgroup_env_type),
INTENT(in) :: sub_env
662 TYPE(qs_environment_type),
POINTER :: qs_env
663 INTEGER,
INTENT(in) :: base_contact, log_unit
665 CHARACTER(LEN=*),
PARAMETER :: routinen =
'shift_potential'
666 TYPE(cp_fm_type),
PARAMETER :: fm_dummy = cp_fm_type()
668 COMPLEX(kind=dp) :: lbound_cpath, ubound_cpath, ubound_lpath
669 INTEGER :: handle, ispin, iter_count, nao, &
671 LOGICAL :: do_kpoints
672 REAL(kind=
dp) :: mu_base, nelectrons_guess, nelectrons_max, nelectrons_min, nelectrons_ref, &
673 t1, t2, temperature, trace, v_shift_guess, v_shift_max, v_shift_min
674 TYPE(cp_blacs_env_type),
POINTER :: blacs_env
675 TYPE(cp_fm_struct_type),
POINTER :: fm_struct
676 TYPE(cp_fm_type),
ALLOCATABLE,
DIMENSION(:) :: rho_ao_fm
677 TYPE(cp_fm_type),
POINTER :: matrix_s_fm
678 TYPE(dbcsr_p_type),
DIMENSION(:, :),
POINTER :: rho_ao_qs_kp
679 TYPE(dft_control_type),
POINTER :: dft_control
680 TYPE(green_functions_cache_type),
ALLOCATABLE, &
681 DIMENSION(:) :: g_surf_circular, g_surf_linear
682 TYPE(integration_status_type) :: stats
683 TYPE(mp_para_env_type),
POINTER :: para_env
684 TYPE(qs_rho_type),
POINTER :: rho_struct
685 TYPE(qs_subsys_type),
POINTER :: subsys
687 ncontacts =
SIZE(negf_control%contacts)
689 IF (.NOT. (
ALLOCATED(negf_env%h_s) .AND.
ALLOCATED(negf_env%h_sc) .AND. &
690 ASSOCIATED(negf_env%s_s) .AND.
ALLOCATED(negf_env%s_sc)))
RETURN
691 IF (ncontacts < 2)
RETURN
693 CALL timeset(routinen, handle)
695 CALL get_qs_env(qs_env, blacs_env=blacs_env, do_kpoints=do_kpoints, dft_control=dft_control, &
696 para_env=para_env, rho=rho_struct, subsys=subsys)
697 cpassert(.NOT. do_kpoints)
703 IF (sub_env%ngroups > 1)
THEN
704 NULLIFY (matrix_s_fm, fm_struct)
709 ALLOCATE (matrix_s_fm)
713 IF (sub_env%group_distribution(sub_env%mepos_global) == 0)
THEN
719 matrix_s_fm => negf_env%s_s
724 nspins =
SIZE(negf_env%h_s)
726 mu_base = negf_control%contacts(base_contact)%fermi_level
729 CALL qs_rho_get(rho_struct, rho_ao_kp=rho_ao_qs_kp)
732 nelectrons_ref = 0.0_dp
733 ALLOCATE (rho_ao_fm(nspins))
738 fm=rho_ao_fm(ispin), &
739 atomlist_row=negf_control%atomlist_S_screening, &
740 atomlist_col=negf_control%atomlist_S_screening, &
741 subsys=subsys, mpi_comm_global=para_env, &
742 do_upper_diag=.true., do_lower=.true.)
744 CALL cp_fm_trace(rho_ao_fm(ispin), matrix_s_fm, trace)
745 nelectrons_ref = nelectrons_ref + trace
748 IF (log_unit > 0)
THEN
749 WRITE (log_unit,
'(/,T2,A)')
"COMPUTE SHIFT IN HARTREE POTENTIAL"
750 WRITE (log_unit,
'(/,T2,A,T55,F25.14,/)')
"Initial electronic density of the scattering region:", -1.0_dp*nelectrons_ref
751 WRITE (log_unit,
'(T3,A)')
"Step Integration method Time V shift Convergence (density)"
752 WRITE (log_unit,
'(T3,78("-"))')
755 temperature = negf_control%contacts(base_contact)%temperature
758 lbound_cpath = cmplx(negf_control%energy_lbound, negf_control%eta, kind=
dp)
759 ubound_cpath = cmplx(mu_base - real(negf_control%gamma_kT, kind=
dp)*temperature, &
760 REAL(negf_control%delta_npoles, kind=
dp)*
twopi*temperature, kind=
dp)
763 ubound_lpath = cmplx(mu_base - log(negf_control%conv_density)*temperature, &
764 REAL(negf_control%delta_npoles, kind=
dp)*
twopi*temperature, kind=
dp)
766 v_shift_min = negf_control%v_shift
767 v_shift_max = negf_control%v_shift + negf_control%v_shift_offset
769 ALLOCATE (g_surf_circular(nspins), g_surf_linear(nspins))
771 DO iter_count = 1, negf_control%v_shift_maxiters
772 SELECT CASE (iter_count)
774 v_shift_guess = v_shift_min
776 v_shift_guess = v_shift_max
778 v_shift_guess = v_shift_min - (nelectrons_min - nelectrons_ref)* &
779 (v_shift_max - v_shift_min)/(nelectrons_max - nelectrons_min)
783 CALL integration_status_reset(stats)
787 CALL negf_init_rho_equiv_residuals(rho_ao_fm=rho_ao_fm(ispin), &
788 v_shift=v_shift_guess, &
789 ignore_bias=.true., &
791 negf_control=negf_control, &
794 base_contact=base_contact)
797 CALL negf_add_rho_equiv_low(rho_ao_fm=rho_ao_fm(ispin), &
799 v_shift=v_shift_guess, &
800 ignore_bias=.true., &
802 negf_control=negf_control, &
805 base_contact=base_contact, &
806 integr_lbound=lbound_cpath, &
807 integr_ubound=ubound_cpath, &
808 matrix_s_global=matrix_s_fm, &
809 is_circular=.true., &
810 g_surf_cache=g_surf_circular(ispin))
811 IF (negf_control%disable_cache) &
815 CALL negf_add_rho_equiv_low(rho_ao_fm=rho_ao_fm(ispin), &
817 v_shift=v_shift_guess, &
818 ignore_bias=.true., &
820 negf_control=negf_control, &
823 base_contact=base_contact, &
824 integr_lbound=ubound_cpath, &
825 integr_ubound=ubound_lpath, &
826 matrix_s_global=matrix_s_fm, &
827 is_circular=.false., &
828 g_surf_cache=g_surf_linear(ispin))
829 IF (negf_control%disable_cache) &
841 CALL cp_fm_trace(rho_ao_fm(1), matrix_s_fm, nelectrons_guess)
845 IF (log_unit > 0)
THEN
846 WRITE (log_unit,
'(T2,I5,T12,A,T32,F8.1,T42,F15.8,T60,ES20.5E2)') &
847 iter_count, get_method_description_string(stats, negf_control%integr_method), &
848 t2 - t1, v_shift_guess, nelectrons_guess - nelectrons_ref
851 IF (abs(nelectrons_guess - nelectrons_ref) < negf_control%conv_scf)
EXIT
854 SELECT CASE (iter_count)
856 nelectrons_min = nelectrons_guess
858 nelectrons_max = nelectrons_guess
860 IF (v_shift_guess < v_shift_min)
THEN
861 v_shift_max = v_shift_min
862 nelectrons_max = nelectrons_min
863 v_shift_min = v_shift_guess
864 nelectrons_min = nelectrons_guess
865 ELSE IF (v_shift_guess > v_shift_max)
THEN
866 v_shift_min = v_shift_max
867 nelectrons_min = nelectrons_max
868 v_shift_max = v_shift_guess
869 nelectrons_max = nelectrons_guess
870 ELSE IF (v_shift_max - v_shift_guess < v_shift_guess - v_shift_min)
THEN
871 v_shift_max = v_shift_guess
872 nelectrons_max = nelectrons_guess
874 v_shift_min = v_shift_guess
875 nelectrons_min = nelectrons_guess
882 negf_control%v_shift = v_shift_guess
884 IF (log_unit > 0)
THEN
885 WRITE (log_unit,
'(T2,A,T62,F18.8)')
"NEGF| Shift in Hartree potential", negf_control%v_shift
888 DO ispin = nspins, 1, -1
892 DEALLOCATE (g_surf_circular, g_surf_linear)
894 CALL cp_fm_release(rho_ao_fm)
896 IF (sub_env%ngroups > 1 .AND.
ASSOCIATED(matrix_s_fm))
THEN
897 CALL cp_fm_release(matrix_s_fm)
898 DEALLOCATE (matrix_s_fm)
901 CALL timestop(handle)
902 END SUBROUTINE shift_potential
916 SUBROUTINE converge_density(negf_env, negf_control, sub_env, qs_env, v_shift, base_contact, log_unit)
917 TYPE(negf_env_type),
INTENT(in) :: negf_env
918 TYPE(negf_control_type),
POINTER :: negf_control
919 TYPE(negf_subgroup_env_type),
INTENT(in) :: sub_env
920 TYPE(qs_environment_type),
POINTER :: qs_env
921 REAL(kind=
dp),
INTENT(in) :: v_shift
922 INTEGER,
INTENT(in) :: base_contact, log_unit
924 CHARACTER(LEN=*),
PARAMETER :: routinen =
'converge_density'
925 REAL(kind=
dp),
PARAMETER :: threshold = 16.0_dp*epsilon(0.0_dp)
926 TYPE(cp_fm_type),
PARAMETER :: fm_dummy = cp_fm_type()
928 COMPLEX(kind=dp) :: lbound_cpath, ubound_cpath, ubound_lpath
929 INTEGER :: handle, icontact, image, ispin, &
930 iter_count, nao, ncontacts, nimages, &
932 LOGICAL :: do_kpoints
933 REAL(kind=
dp) :: iter_delta, mu_base, nelectrons, &
934 nelectrons_diff, t1, t2, temperature, &
935 trace, v_base, v_contact
936 TYPE(cp_blacs_env_type),
POINTER :: blacs_env
937 TYPE(cp_fm_struct_type),
POINTER :: fm_struct
938 TYPE(cp_fm_type),
ALLOCATABLE,
DIMENSION(:) :: rho_ao_delta_fm, rho_ao_new_fm
939 TYPE(cp_fm_type),
POINTER :: matrix_s_fm
940 TYPE(dbcsr_p_type),
DIMENSION(:, :),
POINTER :: matrix_ks_initial_kp, matrix_ks_qs_kp, &
941 rho_ao_initial_kp, rho_ao_new_kp, &
943 TYPE(dft_control_type),
POINTER :: dft_control
944 TYPE(green_functions_cache_type),
ALLOCATABLE, &
945 DIMENSION(:) :: g_surf_circular, g_surf_linear, &
947 TYPE(integration_status_type) :: stats
948 TYPE(mp_para_env_type),
POINTER :: para_env
949 TYPE(qs_rho_type),
POINTER :: rho_struct
950 TYPE(qs_subsys_type),
POINTER :: subsys
952 ncontacts =
SIZE(negf_control%contacts)
954 IF (.NOT. (
ALLOCATED(negf_env%h_s) .AND.
ALLOCATED(negf_env%h_sc) .AND. &
955 ASSOCIATED(negf_env%s_s) .AND.
ALLOCATED(negf_env%s_sc)))
RETURN
956 IF (ncontacts < 2)
RETURN
958 CALL timeset(routinen, handle)
960 CALL get_qs_env(qs_env, blacs_env=blacs_env, do_kpoints=do_kpoints, dft_control=dft_control, &
961 matrix_ks_kp=matrix_ks_qs_kp, para_env=para_env, rho=rho_struct, subsys=subsys)
962 cpassert(.NOT. do_kpoints)
968 IF (sub_env%ngroups > 1)
THEN
969 NULLIFY (matrix_s_fm, fm_struct)
974 ALLOCATE (matrix_s_fm)
978 IF (sub_env%group_distribution(sub_env%mepos_global) == 0)
THEN
984 matrix_s_fm => negf_env%s_s
989 nspins =
SIZE(negf_env%h_s)
990 nimages = dft_control%nimages
992 v_base = negf_control%contacts(base_contact)%v_external
993 mu_base = negf_control%contacts(base_contact)%fermi_level + v_base
996 IF (ncontacts > 2)
THEN
997 cpabort(
"Poisson solver does not support the general NEGF setup (>2 contacts).")
1001 CALL qs_rho_get(rho_struct, rho_ao_kp=rho_ao_qs_kp)
1003 NULLIFY (matrix_ks_initial_kp, rho_ao_initial_kp, rho_ao_new_kp)
1008 DO image = 1, nimages
1009 DO ispin = 1, nspins
1010 CALL dbcsr_init_p(matrix_ks_initial_kp(ispin, image)%matrix)
1011 CALL dbcsr_copy(matrix_b=matrix_ks_initial_kp(ispin, image)%matrix, matrix_a=matrix_ks_qs_kp(ispin, image)%matrix)
1013 CALL dbcsr_init_p(rho_ao_initial_kp(ispin, image)%matrix)
1014 CALL dbcsr_copy(matrix_b=rho_ao_initial_kp(ispin, image)%matrix, matrix_a=rho_ao_qs_kp(ispin, image)%matrix)
1016 CALL dbcsr_init_p(rho_ao_new_kp(ispin, image)%matrix)
1017 CALL dbcsr_copy(matrix_b=rho_ao_new_kp(ispin, image)%matrix, matrix_a=rho_ao_qs_kp(ispin, image)%matrix)
1023 ALLOCATE (rho_ao_delta_fm(nspins), rho_ao_new_fm(nspins))
1024 DO ispin = 1, nspins
1029 fm=rho_ao_delta_fm(ispin), &
1030 atomlist_row=negf_control%atomlist_S_screening, &
1031 atomlist_col=negf_control%atomlist_S_screening, &
1032 subsys=subsys, mpi_comm_global=para_env, &
1033 do_upper_diag=.true., do_lower=.true.)
1035 CALL cp_fm_trace(rho_ao_delta_fm(ispin), matrix_s_fm, trace)
1036 nelectrons = nelectrons + trace
1041 CALL mixing_allocate(qs_env, negf_env%mixing_method, nspins=nspins, mixing_store=negf_env%mixing_storage)
1042 IF (dft_control%qs_control%dftb .OR. dft_control%qs_control%xtb)
THEN
1043 cpabort(
'TB Code not available')
1044 ELSE IF (dft_control%qs_control%semi_empirical)
THEN
1045 cpabort(
'SE Code not possible')
1047 CALL mixing_init(negf_env%mixing_method, rho_struct, negf_env%mixing_storage, para_env)
1051 IF (log_unit > 0)
THEN
1052 WRITE (log_unit,
'(/,T2,A)')
"NEGF SELF-CONSISTENT PROCEDURE"
1053 WRITE (log_unit,
'(/,T2,A,T55,F25.14,/)')
"Initial electronic density of the scattering region:", -1.0_dp*nelectrons
1054 WRITE (log_unit,
'(T3,A)')
"Step Integration method Time Electronic density Convergence"
1055 WRITE (log_unit,
'(T3,78("-"))')
1058 temperature = negf_control%contacts(base_contact)%temperature
1060 DO icontact = 1, ncontacts
1061 IF (icontact /= base_contact)
THEN
1062 v_contact = negf_control%contacts(icontact)%v_external
1065 lbound_cpath = cmplx(negf_control%energy_lbound, negf_control%eta, kind=
dp)
1066 ubound_cpath = cmplx(mu_base - real(negf_control%gamma_kT, kind=
dp)*temperature, &
1067 REAL(negf_control%delta_npoles, kind=
dp)*
twopi*temperature, kind=
dp)
1070 ubound_lpath = cmplx(mu_base - log(negf_control%conv_density)*temperature, &
1071 REAL(negf_control%delta_npoles, kind=
dp)*
twopi*temperature, kind=
dp)
1073 ALLOCATE (g_surf_circular(nspins), g_surf_linear(nspins), g_surf_nonequiv(nspins))
1075 DO iter_count = 1, negf_control%max_scf
1077 CALL integration_status_reset(stats)
1079 DO ispin = 1, nspins
1081 CALL negf_init_rho_equiv_residuals(rho_ao_fm=rho_ao_new_fm(ispin), &
1083 ignore_bias=.false., &
1084 negf_env=negf_env, &
1085 negf_control=negf_control, &
1088 base_contact=base_contact)
1091 CALL negf_add_rho_equiv_low(rho_ao_fm=rho_ao_new_fm(ispin), &
1094 ignore_bias=.false., &
1095 negf_env=negf_env, &
1096 negf_control=negf_control, &
1099 base_contact=base_contact, &
1100 integr_lbound=lbound_cpath, &
1101 integr_ubound=ubound_cpath, &
1102 matrix_s_global=matrix_s_fm, &
1103 is_circular=.true., &
1104 g_surf_cache=g_surf_circular(ispin))
1105 IF (negf_control%disable_cache) &
1109 CALL negf_add_rho_equiv_low(rho_ao_fm=rho_ao_new_fm(ispin), &
1112 ignore_bias=.false., &
1113 negf_env=negf_env, &
1114 negf_control=negf_control, &
1117 base_contact=base_contact, &
1118 integr_lbound=ubound_cpath, &
1119 integr_ubound=ubound_lpath, &
1120 matrix_s_global=matrix_s_fm, &
1121 is_circular=.false., &
1122 g_surf_cache=g_surf_linear(ispin))
1123 IF (negf_control%disable_cache) &
1127 IF (abs(negf_control%contacts(icontact)%v_external - &
1128 negf_control%contacts(base_contact)%v_external) >= threshold)
THEN
1129 CALL negf_add_rho_nonequiv(rho_ao_fm=rho_ao_new_fm(ispin), &
1132 negf_env=negf_env, &
1133 negf_control=negf_control, &
1136 base_contact=base_contact, &
1137 matrix_s_global=matrix_s_fm, &
1138 g_surf_cache=g_surf_nonequiv(ispin))
1139 IF (negf_control%disable_cache) &
1144 IF (nspins == 1)
CALL cp_fm_scale(2.0_dp, rho_ao_new_fm(1))
1147 nelectrons_diff = 0.0_dp
1148 DO ispin = 1, nspins
1149 CALL cp_fm_trace(rho_ao_new_fm(ispin), matrix_s_fm, trace)
1150 nelectrons = nelectrons + trace
1154 CALL cp_fm_trace(rho_ao_delta_fm(ispin), matrix_s_fm, trace)
1155 nelectrons_diff = nelectrons_diff + trace
1158 CALL cp_fm_to_fm(rho_ao_new_fm(ispin), rho_ao_delta_fm(ispin))
1163 IF (log_unit > 0)
THEN
1164 WRITE (log_unit,
'(T2,I5,T12,A,T32,F8.1,T43,F20.8,T65,ES15.5E2)') &
1165 iter_count, get_method_description_string(stats, negf_control%integr_method), &
1166 t2 - t1, -1.0_dp*nelectrons, nelectrons_diff
1169 IF (abs(nelectrons_diff) < negf_control%conv_scf)
EXIT
1175 DO image = 1, nimages
1176 DO ispin = 1, nspins
1177 CALL dbcsr_copy(matrix_b=rho_ao_new_kp(ispin, image)%matrix, &
1178 matrix_a=rho_ao_initial_kp(ispin, image)%matrix)
1182 DO ispin = 1, nspins
1184 matrix=rho_ao_new_kp(ispin, 1)%matrix, &
1185 atomlist_row=negf_control%atomlist_S_screening, &
1186 atomlist_col=negf_control%atomlist_S_screening, &
1191 para_env, iter_delta, iter_count)
1193 DO image = 1, nimages
1194 DO ispin = 1, nspins
1195 CALL dbcsr_copy(rho_ao_qs_kp(ispin, image)%matrix, rho_ao_new_kp(ispin, image)%matrix)
1201 DO image = 1, nimages
1202 DO ispin = 1, nspins
1203 CALL dbcsr_copy(matrix_b=rho_ao_qs_kp(ispin, image)%matrix, &
1204 matrix_a=rho_ao_initial_kp(ispin, image)%matrix)
1208 DO ispin = 1, nspins
1210 matrix=rho_ao_qs_kp(ispin, 1)%matrix, &
1211 atomlist_row=negf_control%atomlist_S_screening, &
1212 atomlist_col=negf_control%atomlist_S_screening, &
1220 CALL gspace_mixing(qs_env, negf_env%mixing_method, negf_env%mixing_storage, &
1221 rho_struct, para_env, iter_count)
1228 DO ispin = 1, nspins
1230 fm=negf_env%h_s(ispin), &
1231 atomlist_row=negf_control%atomlist_S_screening, &
1232 atomlist_col=negf_control%atomlist_S_screening, &
1233 subsys=subsys, mpi_comm_global=para_env, &
1234 do_upper_diag=.true., do_lower=.true.)
1239 IF (log_unit > 0)
THEN
1240 IF (iter_count <= negf_control%max_scf)
THEN
1241 WRITE (log_unit,
'(/,T11,1X,A,I0,A)')
"*** NEGF run converged in ", iter_count,
" iteration(s) ***"
1243 WRITE (log_unit,
'(/,T11,1X,A,I0,A)')
"*** NEGF run did NOT converge after ", iter_count - 1,
" iteration(s) ***"
1247 DO ispin = nspins, 1, -1
1252 DEALLOCATE (g_surf_circular, g_surf_linear, g_surf_nonequiv)
1256 CALL cp_fm_release(rho_ao_new_fm)
1257 CALL cp_fm_release(rho_ao_delta_fm)
1259 DO image = 1, nimages
1260 DO ispin = 1, nspins
1261 CALL dbcsr_copy(matrix_b=matrix_ks_qs_kp(ispin, image)%matrix, matrix_a=matrix_ks_initial_kp(ispin, image)%matrix)
1262 CALL dbcsr_copy(matrix_b=rho_ao_qs_kp(ispin, image)%matrix, matrix_a=rho_ao_initial_kp(ispin, image)%matrix)
1264 CALL dbcsr_deallocate_matrix(matrix_ks_initial_kp(ispin, image)%matrix)
1265 CALL dbcsr_deallocate_matrix(rho_ao_initial_kp(ispin, image)%matrix)
1266 CALL dbcsr_deallocate_matrix(rho_ao_new_kp(ispin, image)%matrix)
1269 DEALLOCATE (matrix_ks_initial_kp, rho_ao_new_kp, rho_ao_initial_kp)
1271 IF (sub_env%ngroups > 1 .AND.
ASSOCIATED(matrix_s_fm))
THEN
1272 CALL cp_fm_release(matrix_s_fm)
1273 DEALLOCATE (matrix_s_fm)
1276 CALL timestop(handle)
1277 END SUBROUTINE converge_density
1294 SUBROUTINE negf_surface_green_function_batch(g_surf, omega, h0, s0, h1, s1, sub_env, v_external, conv, transp)
1295 TYPE(cp_cfm_type),
DIMENSION(:),
INTENT(inout) :: g_surf
1296 COMPLEX(kind=dp),
DIMENSION(:),
INTENT(in) :: omega
1297 TYPE(cp_fm_type),
INTENT(IN) :: h0, s0, h1, s1
1298 TYPE(negf_subgroup_env_type),
INTENT(in) :: sub_env
1299 REAL(kind=
dp),
INTENT(in) :: v_external, conv
1300 LOGICAL,
INTENT(in) :: transp
1302 CHARACTER(len=*),
PARAMETER :: routinen =
'negf_surface_green_function_batch'
1303 TYPE(cp_cfm_type),
PARAMETER :: cfm_null = cp_cfm_type()
1305 INTEGER :: handle, igroup, ipoint, npoints
1306 TYPE(cp_fm_struct_type),
POINTER :: fm_struct
1307 TYPE(sancho_work_matrices_type) :: work
1309 CALL timeset(routinen, handle)
1310 npoints =
SIZE(omega)
1316 igroup = sub_env%group_distribution(sub_env%mepos_global)
1318 g_surf(1:npoints) = cfm_null
1320 DO ipoint = igroup + 1, npoints, sub_env%ngroups
1321 IF (debug_this_module)
THEN
1322 cpassert(.NOT.
ASSOCIATED(g_surf(ipoint)%matrix_struct))
1326 CALL do_sancho(g_surf(ipoint), omega(ipoint) - v_external, &
1327 h0, s0, h1, s1, conv, transp, work)
1331 CALL timestop(handle)
1332 END SUBROUTINE negf_surface_green_function_batch
1364 SUBROUTINE negf_retarded_green_function_batch(omega, v_shift, ignore_bias, negf_env, negf_control, sub_env, ispin, &
1366 g_ret_s, g_ret_scale, gamma_contacts, gret_gamma_gadv, dos, &
1367 transm_coeff, transm_contact1, transm_contact2, just_contact)
1368 COMPLEX(kind=dp),
DIMENSION(:),
INTENT(in) :: omega
1369 REAL(kind=
dp),
INTENT(in) :: v_shift
1370 LOGICAL,
INTENT(in) :: ignore_bias
1371 TYPE(negf_env_type),
INTENT(in) :: negf_env
1372 TYPE(negf_control_type),
POINTER :: negf_control
1373 TYPE(negf_subgroup_env_type),
INTENT(in) :: sub_env
1374 INTEGER,
INTENT(in) :: ispin
1375 TYPE(cp_cfm_type),
DIMENSION(:, :),
INTENT(in) :: g_surf_contacts
1376 TYPE(cp_cfm_type),
DIMENSION(:),
INTENT(in), &
1378 COMPLEX(kind=dp),
DIMENSION(:),
INTENT(in), &
1379 OPTIONAL :: g_ret_scale
1380 TYPE(cp_cfm_type),
DIMENSION(:, :),
INTENT(in), &
1381 OPTIONAL :: gamma_contacts, gret_gamma_gadv
1382 REAL(kind=
dp),
DIMENSION(:),
INTENT(out),
OPTIONAL :: dos
1383 COMPLEX(kind=dp),
DIMENSION(:),
INTENT(out), &
1384 OPTIONAL :: transm_coeff
1385 INTEGER,
INTENT(in),
OPTIONAL :: transm_contact1, transm_contact2, &
1388 CHARACTER(len=*),
PARAMETER :: routinen =
'negf_retarded_green_function_batch'
1390 INTEGER :: handle, icontact, igroup, ipoint, &
1391 ncontacts, npoints, nrows
1392 REAL(kind=
dp) :: v_external
1393 TYPE(copy_cfm_info_type),
ALLOCATABLE, &
1394 DIMENSION(:) :: info1
1395 TYPE(copy_cfm_info_type),
ALLOCATABLE, &
1396 DIMENSION(:, :) :: info2
1397 TYPE(cp_cfm_type),
ALLOCATABLE,
DIMENSION(:) :: g_ret_s_group, self_energy_contacts, &
1398 zwork1_contacts, zwork2_contacts
1399 TYPE(cp_cfm_type),
ALLOCATABLE,
DIMENSION(:, :) :: gamma_contacts_group, &
1400 gret_gamma_gadv_group
1401 TYPE(cp_fm_struct_type),
POINTER :: fm_struct
1402 TYPE(cp_fm_type) :: g_ret_imag
1403 TYPE(cp_fm_type),
POINTER :: matrix_s
1404 TYPE(mp_para_env_type),
POINTER :: para_env
1406 CALL timeset(routinen, handle)
1407 npoints =
SIZE(omega)
1408 ncontacts =
SIZE(negf_env%contacts)
1409 cpassert(
SIZE(negf_control%contacts) == ncontacts)
1411 IF (
PRESENT(just_contact))
THEN
1412 cpassert(just_contact <= ncontacts)
1416 cpassert(ncontacts >= 2)
1418 IF (ignore_bias) v_external = 0.0_dp
1420 IF (
PRESENT(transm_coeff) .OR.
PRESENT(transm_contact1) .OR.
PRESENT(transm_contact2))
THEN
1421 cpassert(
PRESENT(transm_coeff))
1422 cpassert(
PRESENT(transm_contact1))
1423 cpassert(
PRESENT(transm_contact2))
1424 cpassert(.NOT.
PRESENT(just_contact))
1427 ALLOCATE (self_energy_contacts(ncontacts), zwork1_contacts(ncontacts), zwork2_contacts(ncontacts))
1429 IF (
PRESENT(just_contact))
THEN
1430 CALL cp_fm_get_info(negf_env%contacts(just_contact)%s_01, matrix_struct=fm_struct)
1431 DO icontact = 1, ncontacts
1436 CALL cp_fm_get_info(negf_env%contacts(just_contact)%s_00, nrow_global=nrows, matrix_struct=fm_struct)
1437 DO icontact = 1, ncontacts
1438 CALL cp_cfm_create(self_energy_contacts(icontact), fm_struct)
1441 DO icontact = 1, ncontacts
1442 CALL cp_fm_get_info(negf_env%s_sc(icontact), matrix_struct=fm_struct)
1447 CALL cp_fm_get_info(negf_env%s_s, nrow_global=nrows, matrix_struct=fm_struct)
1448 DO icontact = 1, ncontacts
1449 CALL cp_cfm_create(self_energy_contacts(icontact), fm_struct)
1453 IF (
PRESENT(g_ret_s) .OR.
PRESENT(gret_gamma_gadv) .OR. &
1454 PRESENT(dos) .OR.
PRESENT(transm_coeff))
THEN
1455 ALLOCATE (g_ret_s_group(npoints))
1457 IF (sub_env%ngroups <= 1 .AND.
PRESENT(g_ret_s))
THEN
1458 g_ret_s_group(1:npoints) = g_ret_s(1:npoints)
1462 IF (
PRESENT(gamma_contacts) .OR.
PRESENT(gret_gamma_gadv) .OR.
PRESENT(transm_coeff))
THEN
1463 IF (debug_this_module .AND.
PRESENT(gamma_contacts))
THEN
1464 cpassert(
SIZE(gamma_contacts, 1) == ncontacts)
1467 ALLOCATE (gamma_contacts_group(ncontacts, npoints))
1468 IF (sub_env%ngroups <= 1 .AND.
PRESENT(gamma_contacts))
THEN
1469 gamma_contacts_group(1:ncontacts, 1:npoints) = gamma_contacts(1:ncontacts, 1:npoints)
1473 IF (
PRESENT(gret_gamma_gadv))
THEN
1474 IF (debug_this_module .AND.
PRESENT(gret_gamma_gadv))
THEN
1475 cpassert(
SIZE(gret_gamma_gadv, 1) == ncontacts)
1478 ALLOCATE (gret_gamma_gadv_group(ncontacts, npoints))
1479 IF (sub_env%ngroups <= 1)
THEN
1480 gret_gamma_gadv_group(1:ncontacts, 1:npoints) = gret_gamma_gadv(1:ncontacts, 1:npoints)
1484 igroup = sub_env%group_distribution(sub_env%mepos_global)
1486 DO ipoint = 1, npoints
1487 IF (
ASSOCIATED(g_surf_contacts(1, ipoint)%matrix_struct))
THEN
1488 IF (sub_env%ngroups > 1 .OR. .NOT.
PRESENT(g_ret_s))
THEN
1492 IF (
ALLOCATED(g_ret_s_group))
THEN
1497 IF (sub_env%ngroups > 1 .OR. .NOT.
PRESENT(gamma_contacts))
THEN
1498 IF (
ALLOCATED(gamma_contacts_group))
THEN
1499 DO icontact = 1, ncontacts
1500 CALL cp_cfm_create(gamma_contacts_group(icontact, ipoint), fm_struct)
1505 IF (sub_env%ngroups > 1)
THEN
1506 IF (
ALLOCATED(gret_gamma_gadv_group))
THEN
1507 DO icontact = 1, ncontacts
1508 IF (
ASSOCIATED(gret_gamma_gadv(icontact, ipoint)%matrix_struct))
THEN
1509 CALL cp_cfm_create(gret_gamma_gadv_group(icontact, ipoint), fm_struct)
1515 IF (
PRESENT(just_contact))
THEN
1517 DO icontact = 1, ncontacts
1519 omega=omega(ipoint), &
1520 g_surf_c=g_surf_contacts(icontact, ipoint), &
1521 h_sc0=negf_env%contacts(just_contact)%h_01(ispin), &
1522 s_sc0=negf_env%contacts(just_contact)%s_01, &
1523 zwork1=zwork1_contacts(icontact), &
1524 zwork2=zwork2_contacts(icontact), &
1525 transp=(icontact == 1))
1529 DO icontact = 1, ncontacts
1530 IF (.NOT. ignore_bias) v_external = negf_control%contacts(icontact)%v_external
1533 omega=omega(ipoint) - v_external, &
1534 g_surf_c=g_surf_contacts(icontact, ipoint), &
1535 h_sc0=negf_env%h_sc(ispin, icontact), &
1536 s_sc0=negf_env%s_sc(icontact), &
1537 zwork1=zwork1_contacts(icontact), &
1538 zwork2=zwork2_contacts(icontact), &
1544 IF (
ALLOCATED(gamma_contacts_group))
THEN
1545 DO icontact = 1, ncontacts
1547 self_energy_c=self_energy_contacts(icontact))
1551 IF (
ALLOCATED(g_ret_s_group))
THEN
1553 DO icontact = 2, ncontacts
1558 IF (
PRESENT(just_contact))
THEN
1560 omega=omega(ipoint) - v_shift, &
1561 self_energy_ret_sum=self_energy_contacts(1), &
1562 h_s=negf_env%contacts(just_contact)%h_00(ispin), &
1563 s_s=negf_env%contacts(just_contact)%s_00)
1564 ELSE IF (ignore_bias)
THEN
1566 omega=omega(ipoint) - v_shift, &
1567 self_energy_ret_sum=self_energy_contacts(1), &
1568 h_s=negf_env%h_s(ispin), &
1572 omega=omega(ipoint) - v_shift, &
1573 self_energy_ret_sum=self_energy_contacts(1), &
1574 h_s=negf_env%h_s(ispin), &
1576 v_hartree_s=negf_env%v_hartree_s)
1579 IF (
PRESENT(g_ret_scale))
THEN
1580 IF (g_ret_scale(ipoint) /=
z_one)
CALL cp_cfm_scale(g_ret_scale(ipoint), g_ret_s_group(ipoint))
1584 IF (
ALLOCATED(gret_gamma_gadv_group))
THEN
1587 DO icontact = 1, ncontacts
1588 IF (
ASSOCIATED(gret_gamma_gadv_group(icontact, ipoint)%matrix_struct))
THEN
1589 CALL parallel_gemm(
'N',
'C', nrows, nrows, nrows, &
1590 z_one, gamma_contacts_group(icontact, ipoint), &
1591 g_ret_s_group(ipoint), &
1592 z_zero, self_energy_contacts(icontact))
1593 CALL parallel_gemm(
'N',
'N', nrows, nrows, nrows, &
1594 z_one, g_ret_s_group(ipoint), &
1595 self_energy_contacts(icontact), &
1596 z_zero, gret_gamma_gadv_group(icontact, ipoint))
1604 IF (
PRESENT(g_ret_s))
THEN
1605 IF (sub_env%ngroups > 1)
THEN
1607 DO ipoint = 1, npoints
1608 IF (
ASSOCIATED(g_ret_s(ipoint)%matrix_struct))
THEN
1614 IF (
ASSOCIATED(para_env))
THEN
1615 ALLOCATE (info1(npoints))
1617 DO ipoint = 1, npoints
1620 para_env, info1(ipoint))
1623 DO ipoint = 1, npoints
1624 IF (
ASSOCIATED(g_ret_s(ipoint)%matrix_struct))
THEN
1626 IF (
ASSOCIATED(g_ret_s_group(ipoint)%matrix_struct)) &
1636 IF (
PRESENT(gamma_contacts))
THEN
1637 IF (sub_env%ngroups > 1)
THEN
1639 pnt1:
DO ipoint = 1, npoints
1640 DO icontact = 1, ncontacts
1641 IF (
ASSOCIATED(gamma_contacts(icontact, ipoint)%matrix_struct))
THEN
1642 CALL cp_cfm_get_info(gamma_contacts(icontact, ipoint), para_env=para_env)
1648 IF (
ASSOCIATED(para_env))
THEN
1649 ALLOCATE (info2(ncontacts, npoints))
1651 DO ipoint = 1, npoints
1652 DO icontact = 1, ncontacts
1654 gamma_contacts(icontact, ipoint), &
1655 para_env, info2(icontact, ipoint))
1659 DO ipoint = 1, npoints
1660 DO icontact = 1, ncontacts
1661 IF (
ASSOCIATED(gamma_contacts(icontact, ipoint)%matrix_struct))
THEN
1663 IF (
ASSOCIATED(gamma_contacts_group(icontact, ipoint)%matrix_struct))
THEN
1675 IF (
PRESENT(gret_gamma_gadv))
THEN
1676 IF (sub_env%ngroups > 1)
THEN
1679 pnt2:
DO ipoint = 1, npoints
1680 DO icontact = 1, ncontacts
1681 IF (
ASSOCIATED(gret_gamma_gadv(icontact, ipoint)%matrix_struct))
THEN
1682 CALL cp_cfm_get_info(gret_gamma_gadv(icontact, ipoint), para_env=para_env)
1688 IF (
ASSOCIATED(para_env))
THEN
1689 ALLOCATE (info2(ncontacts, npoints))
1691 DO ipoint = 1, npoints
1692 DO icontact = 1, ncontacts
1694 gret_gamma_gadv(icontact, ipoint), &
1695 para_env, info2(icontact, ipoint))
1699 DO ipoint = 1, npoints
1700 DO icontact = 1, ncontacts
1701 IF (
ASSOCIATED(gret_gamma_gadv(icontact, ipoint)%matrix_struct))
THEN
1703 IF (
ASSOCIATED(gret_gamma_gadv_group(icontact, ipoint)%matrix_struct))
THEN
1715 IF (
PRESENT(dos))
THEN
1718 IF (
PRESENT(just_contact))
THEN
1719 matrix_s => negf_env%contacts(just_contact)%s_00
1721 matrix_s => negf_env%s_s
1727 DO ipoint = 1, npoints
1728 IF (
ASSOCIATED(g_ret_s_group(ipoint)%matrix_struct))
THEN
1729 CALL cp_cfm_to_fm(g_ret_s_group(ipoint), mtargeti=g_ret_imag)
1730 CALL cp_fm_trace(g_ret_imag, matrix_s, dos(ipoint))
1731 IF (sub_env%para_env%mepos /= 0) dos(ipoint) = 0.0_dp
1735 CALL cp_fm_release(g_ret_imag)
1737 CALL sub_env%mpi_comm_global%sum(dos)
1738 dos(:) = -1.0_dp/
pi*dos(:)
1741 IF (
PRESENT(transm_coeff))
THEN
1744 DO ipoint = 1, npoints
1745 IF (
ASSOCIATED(g_ret_s_group(ipoint)%matrix_struct))
THEN
1747 CALL parallel_gemm(
'N',
'C', nrows, nrows, nrows, &
1748 z_one, gamma_contacts_group(transm_contact1, ipoint), &
1749 g_ret_s_group(ipoint), &
1750 z_zero, self_energy_contacts(transm_contact1))
1751 CALL parallel_gemm(
'N',
'N', nrows, nrows, nrows, &
1752 z_one, self_energy_contacts(transm_contact1), &
1753 gamma_contacts_group(transm_contact2, ipoint), &
1754 z_zero, self_energy_contacts(transm_contact2))
1758 self_energy_contacts(transm_contact2), &
1759 transm_coeff(ipoint))
1760 IF (sub_env%para_env%mepos /= 0) transm_coeff(ipoint) = 0.0_dp
1765 CALL sub_env%mpi_comm_global%sum(transm_coeff)
1770 IF (
ALLOCATED(g_ret_s_group))
THEN
1771 DO ipoint = npoints, 1, -1
1772 IF (sub_env%ngroups > 1 .OR. .NOT.
PRESENT(g_ret_s))
THEN
1776 DEALLOCATE (g_ret_s_group)
1779 IF (
ALLOCATED(gamma_contacts_group))
THEN
1780 DO ipoint = npoints, 1, -1
1781 DO icontact = ncontacts, 1, -1
1782 IF (sub_env%ngroups > 1 .OR. .NOT.
PRESENT(gamma_contacts))
THEN
1787 DEALLOCATE (gamma_contacts_group)
1790 IF (
ALLOCATED(gret_gamma_gadv_group))
THEN
1791 DO ipoint = npoints, 1, -1
1792 DO icontact = ncontacts, 1, -1
1793 IF (sub_env%ngroups > 1)
THEN
1798 DEALLOCATE (gret_gamma_gadv_group)
1801 IF (
ALLOCATED(self_energy_contacts))
THEN
1802 DO icontact = ncontacts, 1, -1
1805 DEALLOCATE (self_energy_contacts)
1808 IF (
ALLOCATED(zwork1_contacts))
THEN
1809 DO icontact = ncontacts, 1, -1
1812 DEALLOCATE (zwork1_contacts)
1815 IF (
ALLOCATED(zwork2_contacts))
THEN
1816 DO icontact = ncontacts, 1, -1
1819 DEALLOCATE (zwork2_contacts)
1822 CALL timestop(handle)
1823 END SUBROUTINE negf_retarded_green_function_batch
1833 PURE FUNCTION fermi_function(omega, temperature)
RESULT(val)
1834 COMPLEX(kind=dp),
INTENT(in) :: omega
1835 REAL(kind=
dp),
INTENT(in) :: temperature
1836 COMPLEX(kind=dp) :: val
1838 REAL(kind=
dp),
PARAMETER :: max_ln_omega_over_t = log(huge(0.0_dp))/16.0_dp
1840 IF (real(omega, kind=
dp) <= temperature*max_ln_omega_over_t)
THEN
1846 END FUNCTION fermi_function
1861 SUBROUTINE negf_init_rho_equiv_residuals(rho_ao_fm, v_shift, ignore_bias, negf_env, &
1862 negf_control, sub_env, ispin, base_contact, just_contact)
1863 TYPE(cp_fm_type),
INTENT(IN) :: rho_ao_fm
1864 REAL(kind=
dp),
INTENT(in) :: v_shift
1865 LOGICAL,
INTENT(in) :: ignore_bias
1866 TYPE(negf_env_type),
INTENT(in) :: negf_env
1867 TYPE(negf_control_type),
POINTER :: negf_control
1868 TYPE(negf_subgroup_env_type),
INTENT(in) :: sub_env
1869 INTEGER,
INTENT(in) :: ispin, base_contact
1870 INTEGER,
INTENT(in),
OPTIONAL :: just_contact
1872 CHARACTER(LEN=*),
PARAMETER :: routinen =
'negf_init_rho_equiv_residuals'
1874 COMPLEX(kind=dp),
ALLOCATABLE,
DIMENSION(:) :: omega
1875 INTEGER :: handle, icontact, ipole, ncontacts, &
1877 REAL(kind=
dp) :: mu_base, pi_temperature, temperature, &
1879 TYPE(cp_cfm_type),
ALLOCATABLE,
DIMENSION(:) :: g_ret_s
1880 TYPE(cp_fm_struct_type),
POINTER :: fm_struct
1881 TYPE(green_functions_cache_type) :: g_surf_cache
1882 TYPE(mp_para_env_type),
POINTER :: para_env
1884 CALL timeset(routinen, handle)
1886 temperature = negf_control%contacts(base_contact)%temperature
1887 IF (ignore_bias)
THEN
1888 mu_base = negf_control%contacts(base_contact)%fermi_level
1891 mu_base = negf_control%contacts(base_contact)%fermi_level + negf_control%contacts(base_contact)%v_external
1894 pi_temperature =
pi*temperature
1895 npoles = negf_control%delta_npoles
1897 ncontacts =
SIZE(negf_env%contacts)
1898 cpassert(base_contact <= ncontacts)
1899 IF (
PRESENT(just_contact))
THEN
1901 cpassert(just_contact == base_contact)
1904 IF (npoles > 0)
THEN
1905 CALL cp_fm_get_info(rho_ao_fm, para_env=para_env, matrix_struct=fm_struct)
1907 ALLOCATE (omega(npoles), g_ret_s(npoles))
1909 DO ipole = 1, npoles
1912 omega(ipole) = cmplx(mu_base, real(2*ipole - 1, kind=
dp)*pi_temperature, kind=
dp)
1917 IF (
PRESENT(just_contact))
THEN
1922 DO icontact = 1, ncontacts
1923 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, :), &
1925 h0=negf_env%contacts(just_contact)%h_00(ispin), &
1926 s0=negf_env%contacts(just_contact)%s_00, &
1927 h1=negf_env%contacts(just_contact)%h_01(ispin), &
1928 s1=negf_env%contacts(just_contact)%s_01, &
1929 sub_env=sub_env, v_external=0.0_dp, &
1930 conv=negf_control%conv_green, transp=(icontact == 1))
1933 DO icontact = 1, ncontacts
1934 IF (.NOT. ignore_bias) v_external = negf_control%contacts(icontact)%v_external
1936 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, :), &
1938 h0=negf_env%contacts(icontact)%h_00(ispin), &
1939 s0=negf_env%contacts(icontact)%s_00, &
1940 h1=negf_env%contacts(icontact)%h_01(ispin), &
1941 s1=negf_env%contacts(icontact)%s_01, &
1943 v_external=v_external, &
1944 conv=negf_control%conv_green, transp=.false.)
1948 CALL negf_retarded_green_function_batch(omega=omega(:), &
1950 ignore_bias=ignore_bias, &
1951 negf_env=negf_env, &
1952 negf_control=negf_control, &
1955 g_surf_contacts=g_surf_cache%g_surf_contacts, &
1957 just_contact=just_contact)
1961 DO ipole = 2, npoles
1969 DO ipole = npoles, 1, -1
1972 DEALLOCATE (g_ret_s, omega)
1975 CALL timestop(handle)
1976 END SUBROUTINE negf_init_rho_equiv_residuals
1997 SUBROUTINE negf_add_rho_equiv_low(rho_ao_fm, stats, v_shift, ignore_bias, negf_env, negf_control, sub_env, &
1998 ispin, base_contact, integr_lbound, integr_ubound, matrix_s_global, &
1999 is_circular, g_surf_cache, just_contact)
2000 TYPE(cp_fm_type),
INTENT(IN) :: rho_ao_fm
2001 TYPE(integration_status_type),
INTENT(inout) :: stats
2002 REAL(kind=
dp),
INTENT(in) :: v_shift
2003 LOGICAL,
INTENT(in) :: ignore_bias
2004 TYPE(negf_env_type),
INTENT(in) :: negf_env
2005 TYPE(negf_control_type),
POINTER :: negf_control
2006 TYPE(negf_subgroup_env_type),
INTENT(in) :: sub_env
2007 INTEGER,
INTENT(in) :: ispin, base_contact
2008 COMPLEX(kind=dp),
INTENT(in) :: integr_lbound, integr_ubound
2009 TYPE(cp_fm_type),
INTENT(IN) :: matrix_s_global
2010 LOGICAL,
INTENT(in) :: is_circular
2011 TYPE(green_functions_cache_type),
INTENT(inout) :: g_surf_cache
2012 INTEGER,
INTENT(in),
OPTIONAL :: just_contact
2014 CHARACTER(LEN=*),
PARAMETER :: routinen =
'negf_add_rho_equiv_low'
2016 COMPLEX(kind=dp),
ALLOCATABLE,
DIMENSION(:) :: xnodes, zscale
2017 INTEGER :: handle, icontact, interval_id, ipoint, max_points, min_points, ncontacts, &
2018 npoints, npoints_exist, npoints_tmp, npoints_total, shape_id
2019 LOGICAL :: do_surface_green
2020 REAL(kind=
dp) :: conv_integr, mu_base, temperature, &
2022 TYPE(ccquad_type) :: cc_env
2023 TYPE(cp_cfm_type),
ALLOCATABLE,
DIMENSION(:) :: zdata, zdata_tmp
2024 TYPE(cp_fm_struct_type),
POINTER :: fm_struct
2025 TYPE(cp_fm_type) :: integral_imag
2026 TYPE(mp_para_env_type),
POINTER :: para_env
2027 TYPE(simpsonrule_type) :: sr_env
2029 CALL timeset(routinen, handle)
2033 conv_integr = 0.5_dp*negf_control%conv_density*
pi
2035 IF (ignore_bias)
THEN
2036 mu_base = negf_control%contacts(base_contact)%fermi_level
2039 mu_base = negf_control%contacts(base_contact)%fermi_level + negf_control%contacts(base_contact)%v_external
2042 min_points = negf_control%integr_min_points
2043 max_points = negf_control%integr_max_points
2044 temperature = negf_control%contacts(base_contact)%temperature
2046 ncontacts =
SIZE(negf_env%contacts)
2047 cpassert(base_contact <= ncontacts)
2048 IF (
PRESENT(just_contact))
THEN
2050 cpassert(just_contact == base_contact)
2053 do_surface_green = .NOT.
ALLOCATED(g_surf_cache%tnodes)
2055 IF (do_surface_green)
THEN
2056 npoints = min_points
2058 npoints =
SIZE(g_surf_cache%tnodes)
2062 CALL cp_fm_get_info(rho_ao_fm, para_env=para_env, matrix_struct=fm_struct)
2065 SELECT CASE (negf_control%integr_method)
2068 ALLOCATE (xnodes(npoints))
2070 IF (is_circular)
THEN
2078 IF (do_surface_green)
THEN
2079 CALL ccquad_init(cc_env, xnodes, npoints, integr_lbound, integr_ubound, &
2080 interval_id, shape_id, matrix_s_global)
2082 CALL ccquad_init(cc_env, xnodes, npoints, integr_lbound, integr_ubound, &
2083 interval_id, shape_id, matrix_s_global, tnodes_restart=g_surf_cache%tnodes)
2086 ALLOCATE (zdata(npoints))
2087 DO ipoint = 1, npoints
2092 IF (do_surface_green)
THEN
2095 IF (
PRESENT(just_contact))
THEN
2097 DO icontact = 1, ncontacts
2098 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, npoints_total + 1:), &
2099 omega=xnodes(1:npoints), &
2100 h0=negf_env%contacts(just_contact)%h_00(ispin), &
2101 s0=negf_env%contacts(just_contact)%s_00, &
2102 h1=negf_env%contacts(just_contact)%h_01(ispin), &
2103 s1=negf_env%contacts(just_contact)%s_01, &
2104 sub_env=sub_env, v_external=0.0_dp, &
2105 conv=negf_control%conv_green, transp=(icontact == 1))
2108 DO icontact = 1, ncontacts
2109 IF (.NOT. ignore_bias) v_external = negf_control%contacts(icontact)%v_external
2111 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, npoints_total + 1:), &
2112 omega=xnodes(1:npoints), &
2113 h0=negf_env%contacts(icontact)%h_00(ispin), &
2114 s0=negf_env%contacts(icontact)%s_00, &
2115 h1=negf_env%contacts(icontact)%h_01(ispin), &
2116 s1=negf_env%contacts(icontact)%s_01, &
2118 v_external=v_external, &
2119 conv=negf_control%conv_green, transp=.false.)
2124 ALLOCATE (zscale(npoints))
2126 IF (temperature >= 0.0_dp)
THEN
2127 DO ipoint = 1, npoints
2128 zscale(ipoint) = fermi_function(xnodes(ipoint) - mu_base, temperature)
2134 CALL negf_retarded_green_function_batch(omega=xnodes(1:npoints), &
2136 ignore_bias=ignore_bias, &
2137 negf_env=negf_env, &
2138 negf_control=negf_control, &
2141 g_surf_contacts=g_surf_cache%g_surf_contacts(:, npoints_total + 1:), &
2142 g_ret_s=zdata(1:npoints), &
2143 g_ret_scale=zscale(1:npoints), &
2144 just_contact=just_contact)
2146 DEALLOCATE (xnodes, zscale)
2147 npoints_total = npoints_total + npoints
2150 CALL move_alloc(zdata, zdata_tmp)
2154 IF (cc_env%error <= conv_integr)
EXIT
2155 IF (2*(npoints_total - 1) + 1 > max_points)
EXIT
2159 do_surface_green = .true.
2161 npoints_tmp = npoints
2163 npoints =
SIZE(xnodes)
2165 ALLOCATE (zdata(npoints))
2168 DO ipoint = 1, npoints_tmp
2169 IF (
ASSOCIATED(zdata_tmp(ipoint)%matrix_struct))
THEN
2170 npoints_exist = npoints_exist + 1
2171 zdata(npoints_exist) = zdata_tmp(ipoint)
2174 DEALLOCATE (zdata_tmp)
2176 DO ipoint = npoints_exist + 1, npoints
2182 stats%error = stats%error + cc_env%error/
pi
2184 DO ipoint =
SIZE(zdata_tmp), 1, -1
2187 DEALLOCATE (zdata_tmp)
2189 CALL cp_cfm_to_fm(cc_env%integral, mtargeti=integral_imag)
2192 IF (do_surface_green)
THEN
2199 ALLOCATE (xnodes(npoints), zdata(npoints), zscale(npoints))
2201 IF (is_circular)
THEN
2207 IF (do_surface_green)
THEN
2208 CALL simpsonrule_init(sr_env, xnodes, npoints, integr_lbound, integr_ubound, &
2209 shape_id, conv_integr, matrix_s_global)
2211 CALL simpsonrule_init(sr_env, xnodes, npoints, integr_lbound, integr_ubound, &
2212 shape_id, conv_integr, matrix_s_global, tnodes_restart=g_surf_cache%tnodes)
2215 DO WHILE (npoints > 0 .AND. npoints_total < max_points)
2216 DO ipoint = 1, npoints
2220 IF (do_surface_green)
THEN
2223 IF (
PRESENT(just_contact))
THEN
2225 DO icontact = 1, ncontacts
2226 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, npoints_total + 1:), &
2227 omega=xnodes(1:npoints), &
2228 h0=negf_env%contacts(just_contact)%h_00(ispin), &
2229 s0=negf_env%contacts(just_contact)%s_00, &
2230 h1=negf_env%contacts(just_contact)%h_01(ispin), &
2231 s1=negf_env%contacts(just_contact)%s_01, &
2232 sub_env=sub_env, v_external=0.0_dp, &
2233 conv=negf_control%conv_green, transp=(icontact == 1))
2236 DO icontact = 1, ncontacts
2237 IF (.NOT. ignore_bias) v_external = negf_control%contacts(icontact)%v_external
2239 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, npoints_total + 1:), &
2240 omega=xnodes(1:npoints), &
2241 h0=negf_env%contacts(icontact)%h_00(ispin), &
2242 s0=negf_env%contacts(icontact)%s_00, &
2243 h1=negf_env%contacts(icontact)%h_01(ispin), &
2244 s1=negf_env%contacts(icontact)%s_01, &
2246 v_external=v_external, &
2247 conv=negf_control%conv_green, transp=.false.)
2252 IF (temperature >= 0.0_dp)
THEN
2253 DO ipoint = 1, npoints
2254 zscale(ipoint) = fermi_function(xnodes(ipoint) - mu_base, temperature)
2260 CALL negf_retarded_green_function_batch(omega=xnodes(1:npoints), &
2262 ignore_bias=ignore_bias, &
2263 negf_env=negf_env, &
2264 negf_control=negf_control, &
2267 g_surf_contacts=g_surf_cache%g_surf_contacts(:, npoints_total + 1:), &
2268 g_ret_s=zdata(1:npoints), &
2269 g_ret_scale=zscale(1:npoints), &
2270 just_contact=just_contact)
2272 npoints_total = npoints_total + npoints
2276 IF (sr_env%error <= conv_integr)
EXIT
2281 do_surface_green = .true.
2283 npoints = max_points - npoints_total
2284 IF (npoints <= 0)
EXIT
2285 IF (npoints >
SIZE(xnodes)) npoints =
SIZE(xnodes)
2291 stats%error = stats%error + sr_env%error/
pi
2293 CALL cp_cfm_to_fm(sr_env%integral, mtargeti=integral_imag)
2296 IF (do_surface_green)
THEN
2301 DEALLOCATE (xnodes, zdata, zscale)
2304 cpabort(
"Unimplemented integration method")
2307 stats%npoints = stats%npoints + npoints_total
2310 CALL cp_fm_release(integral_imag)
2312 CALL timestop(handle)
2313 END SUBROUTINE negf_add_rho_equiv_low
2329 SUBROUTINE negf_add_rho_nonequiv(rho_ao_fm, stats, v_shift, negf_env, negf_control, sub_env, &
2330 ispin, base_contact, matrix_s_global, g_surf_cache)
2331 TYPE(cp_fm_type),
INTENT(IN) :: rho_ao_fm
2332 TYPE(integration_status_type),
INTENT(inout) :: stats
2333 REAL(kind=
dp),
INTENT(in) :: v_shift
2334 TYPE(negf_env_type),
INTENT(in) :: negf_env
2335 TYPE(negf_control_type),
POINTER :: negf_control
2336 TYPE(negf_subgroup_env_type),
INTENT(in) :: sub_env
2337 INTEGER,
INTENT(in) :: ispin, base_contact
2338 TYPE(cp_fm_type),
INTENT(IN) :: matrix_s_global
2339 TYPE(green_functions_cache_type),
INTENT(inout) :: g_surf_cache
2341 CHARACTER(LEN=*),
PARAMETER :: routinen =
'negf_add_rho_nonequiv'
2343 COMPLEX(kind=dp) :: fermi_base, fermi_contact, &
2344 integr_lbound, integr_ubound
2345 COMPLEX(kind=dp),
ALLOCATABLE,
DIMENSION(:) :: xnodes
2346 INTEGER :: handle, icontact, ipoint, jcontact, &
2347 max_points, min_points, ncontacts, &
2348 npoints, npoints_total
2349 LOGICAL :: do_surface_green
2350 REAL(kind=
dp) :: conv_density, conv_integr, eta, &
2351 ln_conv_density, mu_base, mu_contact, &
2352 temperature_base, temperature_contact
2353 TYPE(cp_cfm_type),
ALLOCATABLE,
DIMENSION(:, :) :: zdata
2354 TYPE(cp_fm_struct_type),
POINTER :: fm_struct
2355 TYPE(cp_fm_type) :: integral_real
2356 TYPE(simpsonrule_type) :: sr_env
2358 CALL timeset(routinen, handle)
2360 ncontacts =
SIZE(negf_env%contacts)
2361 cpassert(base_contact <= ncontacts)
2364 IF (ncontacts > 2)
THEN
2365 cpabort(
"Poisson solver does not support the general NEGF setup (>2 contacts).")
2368 mu_base = negf_control%contacts(base_contact)%fermi_level + negf_control%contacts(base_contact)%v_external
2369 min_points = negf_control%integr_min_points
2370 max_points = negf_control%integr_max_points
2371 temperature_base = negf_control%contacts(base_contact)%temperature
2372 eta = negf_control%eta
2373 conv_density = negf_control%conv_density
2374 ln_conv_density = log(conv_density)
2378 conv_integr = 0.5_dp*conv_density*
pi
2380 DO icontact = 1, ncontacts
2381 IF (icontact /= base_contact)
THEN
2382 mu_contact = negf_control%contacts(icontact)%fermi_level + negf_control%contacts(icontact)%v_external
2383 temperature_contact = negf_control%contacts(icontact)%temperature
2385 integr_lbound = cmplx(min(mu_base + ln_conv_density*temperature_base, &
2386 mu_contact + ln_conv_density*temperature_contact), eta, kind=
dp)
2387 integr_ubound = cmplx(max(mu_base - ln_conv_density*temperature_base, &
2388 mu_contact - ln_conv_density*temperature_contact), eta, kind=
dp)
2390 do_surface_green = .NOT.
ALLOCATED(g_surf_cache%tnodes)
2392 IF (do_surface_green)
THEN
2393 npoints = min_points
2395 npoints =
SIZE(g_surf_cache%tnodes)
2401 ALLOCATE (xnodes(npoints), zdata(ncontacts, npoints))
2403 IF (do_surface_green)
THEN
2404 CALL simpsonrule_init(sr_env, xnodes, npoints, integr_lbound, integr_ubound, &
2407 CALL simpsonrule_init(sr_env, xnodes, npoints, integr_lbound, integr_ubound, &
2408 sr_shape_linear, conv_integr, matrix_s_global, tnodes_restart=g_surf_cache%tnodes)
2411 DO WHILE (npoints > 0 .AND. npoints_total < max_points)
2412 IF (do_surface_green)
THEN
2415 DO jcontact = 1, ncontacts
2416 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(jcontact, npoints_total + 1:), &
2417 omega=xnodes(1:npoints), &
2418 h0=negf_env%contacts(jcontact)%h_00(ispin), &
2419 s0=negf_env%contacts(jcontact)%s_00, &
2420 h1=negf_env%contacts(jcontact)%h_01(ispin), &
2421 s1=negf_env%contacts(jcontact)%s_01, &
2423 v_external=negf_control%contacts(jcontact)%v_external, &
2424 conv=negf_control%conv_green, transp=.false.)
2428 DO ipoint = 1, npoints
2432 CALL negf_retarded_green_function_batch(omega=xnodes(1:npoints), &
2434 ignore_bias=.false., &
2435 negf_env=negf_env, &
2436 negf_control=negf_control, &
2439 g_surf_contacts=g_surf_cache%g_surf_contacts(:, npoints_total + 1:), &
2440 gret_gamma_gadv=zdata(:, 1:npoints))
2442 DO ipoint = 1, npoints
2443 fermi_base = fermi_function(cmplx(real(xnodes(ipoint), kind=
dp) - mu_base, 0.0_dp, kind=
dp), &
2445 fermi_contact = fermi_function(cmplx(real(xnodes(ipoint), kind=
dp) - mu_contact, 0.0_dp, kind=
dp), &
2446 temperature_contact)
2447 CALL cp_cfm_scale(fermi_contact - fermi_base, zdata(icontact, ipoint))
2450 npoints_total = npoints_total + npoints
2454 IF (sr_env%error <= conv_integr)
EXIT
2457 do_surface_green = .true.
2459 npoints = max_points - npoints_total
2460 IF (npoints <= 0)
EXIT
2461 IF (npoints >
SIZE(xnodes)) npoints =
SIZE(xnodes)
2468 CALL cp_cfm_to_fm(sr_env%integral, mtargetr=integral_real)
2471 CALL cp_fm_release(integral_real)
2473 DEALLOCATE (xnodes, zdata)
2475 stats%error = stats%error + sr_env%error*0.5_dp/
pi
2476 stats%npoints = stats%npoints + npoints_total
2479 IF (do_surface_green)
THEN
2487 CALL timestop(handle)
2488 END SUBROUTINE negf_add_rho_nonequiv
2495 ELEMENTAL SUBROUTINE integration_status_reset(stats)
2496 TYPE(integration_status_type),
INTENT(out) :: stats
2499 stats%error = 0.0_dp
2500 END SUBROUTINE integration_status_reset
2509 ELEMENTAL FUNCTION get_method_description_string(stats, integration_method)
RESULT(method_descr)
2510 TYPE(integration_status_type),
INTENT(in) :: stats
2511 INTEGER,
INTENT(in) :: integration_method
2512 CHARACTER(len=18) :: method_descr
2514 CHARACTER(len=2) :: method_abbr
2515 CHARACTER(len=6) :: npoints_str
2517 SELECT CASE (integration_method)
2528 WRITE (npoints_str,
'(I6)') stats%npoints
2529 WRITE (method_descr,
'(A2,T4,A,T11,ES8.2E2)') method_abbr, trim(adjustl(npoints_str)), stats%error
2530 END FUNCTION get_method_description_string
2545 FUNCTION negf_compute_current(contact_id1, contact_id2, v_shift, negf_env, negf_control, sub_env, ispin, &
2546 blacs_env_global)
RESULT(current)
2547 INTEGER,
INTENT(in) :: contact_id1, contact_id2
2548 REAL(kind=
dp),
INTENT(in) :: v_shift
2549 TYPE(negf_env_type),
INTENT(in) :: negf_env
2550 TYPE(negf_control_type),
POINTER :: negf_control
2551 TYPE(negf_subgroup_env_type),
INTENT(in) :: sub_env
2552 INTEGER,
INTENT(in) :: ispin
2553 TYPE(cp_blacs_env_type),
POINTER :: blacs_env_global
2554 REAL(kind=
dp) :: current
2556 CHARACTER(LEN=*),
PARAMETER :: routinen =
'negf_compute_current'
2557 REAL(kind=
dp),
PARAMETER :: threshold = 16.0_dp*epsilon(0.0_dp)
2559 COMPLEX(kind=dp) :: fermi_contact1, fermi_contact2, &
2560 integr_lbound, integr_ubound
2561 COMPLEX(kind=dp),
ALLOCATABLE,
DIMENSION(:) :: transm_coeff, xnodes
2562 COMPLEX(kind=dp),
DIMENSION(1, 1) :: transmission
2563 INTEGER :: handle, icontact, ipoint, max_points, &
2564 min_points, ncontacts, npoints, &
2566 REAL(kind=
dp) :: conv_density, energy, eta, ln_conv_density, mu_contact1, mu_contact2, &
2567 temperature_contact1, temperature_contact2, v_contact1, v_contact2
2568 TYPE(cp_cfm_type),
ALLOCATABLE,
DIMENSION(:) :: zdata
2569 TYPE(cp_fm_struct_type),
POINTER :: fm_struct_single
2570 TYPE(cp_fm_type) :: weights
2571 TYPE(green_functions_cache_type) :: g_surf_cache
2572 TYPE(simpsonrule_type) :: sr_env
2576 IF (.NOT.
ASSOCIATED(negf_env%s_s))
RETURN
2578 CALL timeset(routinen, handle)
2580 ncontacts =
SIZE(negf_env%contacts)
2581 cpassert(contact_id1 <= ncontacts)
2582 cpassert(contact_id2 <= ncontacts)
2583 cpassert(contact_id1 /= contact_id2)
2585 v_contact1 = negf_control%contacts(contact_id1)%v_external
2586 mu_contact1 = negf_control%contacts(contact_id1)%fermi_level + v_contact1
2587 v_contact2 = negf_control%contacts(contact_id2)%v_external
2588 mu_contact2 = negf_control%contacts(contact_id2)%fermi_level + v_contact2
2590 IF (abs(mu_contact1 - mu_contact2) < threshold)
THEN
2591 CALL timestop(handle)
2595 min_points = negf_control%integr_min_points
2596 max_points = negf_control%integr_max_points
2597 temperature_contact1 = negf_control%contacts(contact_id1)%temperature
2598 temperature_contact2 = negf_control%contacts(contact_id2)%temperature
2599 eta = negf_control%eta
2600 conv_density = negf_control%conv_density
2601 ln_conv_density = log(conv_density)
2603 integr_lbound = cmplx(min(mu_contact1 + ln_conv_density*temperature_contact1, &
2604 mu_contact2 + ln_conv_density*temperature_contact2), eta, kind=
dp)
2605 integr_ubound = cmplx(max(mu_contact1 - ln_conv_density*temperature_contact1, &
2606 mu_contact2 - ln_conv_density*temperature_contact2), eta, kind=
dp)
2609 npoints = min_points
2611 NULLIFY (fm_struct_single)
2612 CALL cp_fm_struct_create(fm_struct_single, nrow_global=1, ncol_global=1, context=blacs_env_global)
2616 ALLOCATE (transm_coeff(npoints), xnodes(npoints), zdata(npoints))
2618 CALL simpsonrule_init(sr_env, xnodes, npoints, integr_lbound, integr_ubound, &
2621 DO WHILE (npoints > 0 .AND. npoints_total < max_points)
2624 DO icontact = 1, ncontacts
2625 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, 1:npoints), &
2626 omega=xnodes(1:npoints), &
2627 h0=negf_env%contacts(icontact)%h_00(ispin), &
2628 s0=negf_env%contacts(icontact)%s_00, &
2629 h1=negf_env%contacts(icontact)%h_01(ispin), &
2630 s1=negf_env%contacts(icontact)%s_01, &
2632 v_external=negf_control%contacts(icontact)%v_external, &
2633 conv=negf_control%conv_green, transp=.false.)
2636 CALL negf_retarded_green_function_batch(omega=xnodes(1:npoints), &
2638 ignore_bias=.false., &
2639 negf_env=negf_env, &
2640 negf_control=negf_control, &
2643 g_surf_contacts=g_surf_cache%g_surf_contacts(:, 1:npoints), &
2644 transm_coeff=transm_coeff(1:npoints), &
2645 transm_contact1=contact_id1, &
2646 transm_contact2=contact_id2)
2648 DO ipoint = 1, npoints
2651 energy = real(xnodes(ipoint), kind=
dp)
2652 fermi_contact1 = fermi_function(cmplx(energy - mu_contact1, 0.0_dp, kind=
dp), temperature_contact1)
2653 fermi_contact2 = fermi_function(cmplx(energy - mu_contact2, 0.0_dp, kind=
dp), temperature_contact2)
2655 transmission(1, 1) = transm_coeff(ipoint)*(fermi_contact1 - fermi_contact2)
2661 npoints_total = npoints_total + npoints
2665 IF (sr_env%error <= negf_control%conv_density)
EXIT
2667 npoints = max_points - npoints_total
2668 IF (npoints <= 0)
EXIT
2669 IF (npoints >
SIZE(xnodes)) npoints =
SIZE(xnodes)
2678 CALL cp_fm_release(weights)
2682 DEALLOCATE (transm_coeff, xnodes, zdata)
2684 CALL timestop(handle)
2685 END FUNCTION negf_compute_current
2702 SUBROUTINE negf_print_dos(log_unit, energy_min, energy_max, npoints, v_shift, negf_env, &
2703 negf_control, sub_env, base_contact, just_contact, volume)
2704 INTEGER,
INTENT(in) :: log_unit
2705 REAL(kind=
dp),
INTENT(in) :: energy_min, energy_max
2706 INTEGER,
INTENT(in) :: npoints
2707 REAL(kind=
dp),
INTENT(in) :: v_shift
2708 TYPE(negf_env_type),
INTENT(in) :: negf_env
2709 TYPE(negf_control_type),
POINTER :: negf_control
2710 TYPE(negf_subgroup_env_type),
INTENT(in) :: sub_env
2711 INTEGER,
INTENT(in) :: base_contact
2712 INTEGER,
INTENT(in),
OPTIONAL :: just_contact
2713 REAL(kind=
dp),
INTENT(in),
OPTIONAL :: volume
2715 CHARACTER(LEN=*),
PARAMETER :: routinen =
'negf_print_dos'
2717 CHARACTER :: uks_str
2718 CHARACTER(len=15) :: units_str
2719 COMPLEX(kind=dp),
ALLOCATABLE,
DIMENSION(:) :: xnodes
2720 INTEGER :: handle, icontact, ipoint, ispin, &
2721 ncontacts, npoints_bundle, &
2722 npoints_remain, nspins
2723 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: dos
2724 TYPE(green_functions_cache_type) :: g_surf_cache
2726 CALL timeset(routinen, handle)
2728 IF (
PRESENT(just_contact))
THEN
2729 nspins =
SIZE(negf_env%contacts(just_contact)%h_00)
2731 nspins =
SIZE(negf_env%h_s)
2734 IF (log_unit > 0)
THEN
2735 IF (
PRESENT(volume))
THEN
2736 units_str =
' (angstroms^-3)'
2741 IF (nspins > 1)
THEN
2749 IF (
PRESENT(just_contact))
THEN
2750 WRITE (log_unit,
'(3A,T70,I11)')
"# Density of states", trim(units_str),
" for the contact No. ", just_contact
2752 WRITE (log_unit,
'(3A)')
"# Density of states", trim(units_str),
" for the scattering region"
2755 WRITE (log_unit,
'(A,T10,A,T43,3A)')
"#",
"Energy (a.u.)",
"Number of states [alpha ", uks_str,
" beta]"
2757 WRITE (log_unit,
'("#", T3,78("-"))')
2760 ncontacts =
SIZE(negf_env%contacts)
2761 cpassert(base_contact <= ncontacts)
2762 IF (
PRESENT(just_contact))
THEN
2764 cpassert(just_contact == base_contact)
2766 mark_used(base_contact)
2768 npoints_bundle = 4*sub_env%ngroups
2769 IF (npoints_bundle > npoints) npoints_bundle = npoints
2771 ALLOCATE (dos(npoints_bundle, nspins), xnodes(npoints_bundle))
2773 npoints_remain = npoints
2774 DO WHILE (npoints_remain > 0)
2775 IF (npoints_bundle > npoints_remain) npoints_bundle = npoints_remain
2777 IF (npoints > 1)
THEN
2778 DO ipoint = 1, npoints_bundle
2779 xnodes(ipoint) = cmplx(energy_min + real(npoints - npoints_remain + ipoint - 1, kind=
dp)/ &
2780 REAL(npoints - 1, kind=
dp)*(energy_max - energy_min), negf_control%eta, kind=
dp)
2783 xnodes(ipoint) = cmplx(energy_min, negf_control%eta, kind=
dp)
2786 DO ispin = 1, nspins
2789 IF (
PRESENT(just_contact))
THEN
2790 DO icontact = 1, ncontacts
2791 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, :), &
2792 omega=xnodes(1:npoints_bundle), &
2793 h0=negf_env%contacts(just_contact)%h_00(ispin), &
2794 s0=negf_env%contacts(just_contact)%s_00, &
2795 h1=negf_env%contacts(just_contact)%h_01(ispin), &
2796 s1=negf_env%contacts(just_contact)%s_01, &
2797 sub_env=sub_env, v_external=0.0_dp, &
2798 conv=negf_control%conv_green, transp=(icontact == 1))
2801 DO icontact = 1, ncontacts
2802 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, :), &
2803 omega=xnodes(1:npoints_bundle), &
2804 h0=negf_env%contacts(icontact)%h_00(ispin), &
2805 s0=negf_env%contacts(icontact)%s_00, &
2806 h1=negf_env%contacts(icontact)%h_01(ispin), &
2807 s1=negf_env%contacts(icontact)%s_01, &
2809 v_external=negf_control%contacts(icontact)%v_external, &
2810 conv=negf_control%conv_green, transp=.false.)
2814 CALL negf_retarded_green_function_batch(omega=xnodes(1:npoints_bundle), &
2816 ignore_bias=.false., &
2817 negf_env=negf_env, &
2818 negf_control=negf_control, &
2821 g_surf_contacts=g_surf_cache%g_surf_contacts, &
2822 dos=dos(1:npoints_bundle, ispin), &
2823 just_contact=just_contact)
2828 IF (log_unit > 0)
THEN
2829 DO ipoint = 1, npoints_bundle
2830 IF (nspins > 1)
THEN
2832 WRITE (log_unit,
'(T2,F20.8,T30,2ES25.11E3)') real(xnodes(ipoint), kind=
dp), dos(ipoint, 1), dos(ipoint, 2)
2835 WRITE (log_unit,
'(T2,F20.8,T43,ES25.11E3)') real(xnodes(ipoint), kind=
dp), 2.0_dp*dos(ipoint, 1)
2840 npoints_remain = npoints_remain - npoints_bundle
2843 DEALLOCATE (dos, xnodes)
2844 CALL timestop(handle)
2845 END SUBROUTINE negf_print_dos
2861 SUBROUTINE negf_print_transmission(log_unit, energy_min, energy_max, npoints, v_shift, negf_env, &
2862 negf_control, sub_env, contact_id1, contact_id2)
2863 INTEGER,
INTENT(in) :: log_unit
2864 REAL(kind=
dp),
INTENT(in) :: energy_min, energy_max
2865 INTEGER,
INTENT(in) :: npoints
2866 REAL(kind=
dp),
INTENT(in) :: v_shift
2867 TYPE(negf_env_type),
INTENT(in) :: negf_env
2868 TYPE(negf_control_type),
POINTER :: negf_control
2869 TYPE(negf_subgroup_env_type),
INTENT(in) :: sub_env
2870 INTEGER,
INTENT(in) :: contact_id1, contact_id2
2872 CHARACTER(LEN=*),
PARAMETER :: routinen =
'negf_print_transmission'
2874 CHARACTER :: uks_str
2875 COMPLEX(kind=dp),
ALLOCATABLE,
DIMENSION(:) :: xnodes
2876 COMPLEX(kind=dp),
ALLOCATABLE,
DIMENSION(:, :) :: transm_coeff
2877 INTEGER :: handle, icontact, ipoint, ispin, &
2878 ncontacts, npoints_bundle, &
2879 npoints_remain, nspins
2880 REAL(kind=
dp) :: rscale
2881 TYPE(green_functions_cache_type) :: g_surf_cache
2883 CALL timeset(routinen, handle)
2885 nspins =
SIZE(negf_env%h_s)
2887 IF (nspins > 1)
THEN
2895 IF (log_unit > 0)
THEN
2896 WRITE (log_unit,
'(A)')
"# Transmission coefficient (G0 = 2 e^2/h) for the scattering region"
2898 WRITE (log_unit,
'(A,T10,A,T39,3A)')
"#",
"Energy (a.u.)",
"Transmission coefficient [alpha ", uks_str,
" beta]"
2899 WRITE (log_unit,
'("#", T3,78("-"))')
2902 ncontacts =
SIZE(negf_env%contacts)
2903 cpassert(contact_id1 <= ncontacts)
2904 cpassert(contact_id2 <= ncontacts)
2906 IF (nspins == 1)
THEN
2914 rscale = 0.5_dp*rscale
2916 npoints_bundle = 4*sub_env%ngroups
2917 IF (npoints_bundle > npoints) npoints_bundle = npoints
2919 ALLOCATE (transm_coeff(npoints_bundle, nspins), xnodes(npoints_bundle))
2921 npoints_remain = npoints
2922 DO WHILE (npoints_remain > 0)
2923 IF (npoints_bundle > npoints_remain) npoints_bundle = npoints_remain
2925 IF (npoints > 1)
THEN
2926 DO ipoint = 1, npoints_bundle
2927 xnodes(ipoint) = cmplx(energy_min + real(npoints - npoints_remain + ipoint - 1, kind=
dp)/ &
2928 REAL(npoints - 1, kind=
dp)*(energy_max - energy_min), negf_control%eta, kind=
dp)
2931 xnodes(ipoint) = cmplx(energy_min, negf_control%eta, kind=
dp)
2934 DO ispin = 1, nspins
2937 DO icontact = 1, ncontacts
2938 CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, :), &
2939 omega=xnodes(1:npoints_bundle), &
2940 h0=negf_env%contacts(icontact)%h_00(ispin), &
2941 s0=negf_env%contacts(icontact)%s_00, &
2942 h1=negf_env%contacts(icontact)%h_01(ispin), &
2943 s1=negf_env%contacts(icontact)%s_01, &
2945 v_external=negf_control%contacts(icontact)%v_external, &
2946 conv=negf_control%conv_green, transp=.false.)
2949 CALL negf_retarded_green_function_batch(omega=xnodes(1:npoints_bundle), &
2951 ignore_bias=.false., &
2952 negf_env=negf_env, &
2953 negf_control=negf_control, &
2956 g_surf_contacts=g_surf_cache%g_surf_contacts, &
2957 transm_coeff=transm_coeff(1:npoints_bundle, ispin), &
2958 transm_contact1=contact_id1, &
2959 transm_contact2=contact_id2)
2964 IF (log_unit > 0)
THEN
2965 DO ipoint = 1, npoints_bundle
2966 IF (nspins > 1)
THEN
2968 WRITE (log_unit,
'(T2,F20.8,T30,2ES25.11E3)') &
2969 REAL(xnodes(ipoint), kind=
dp), rscale*real(transm_coeff(ipoint, 1:2), kind=
dp)
2972 WRITE (log_unit,
'(T2,F20.8,T43,ES25.11E3)') &
2973 REAL(xnodes(ipoint), kind=
dp), rscale*real(transm_coeff(ipoint, 1), kind=
dp)
2978 npoints_remain = npoints_remain - npoints_bundle
2981 DEALLOCATE (transm_coeff, xnodes)
2982 CALL timestop(handle)
2983 END SUBROUTINE negf_print_transmission
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_create(matrix, matrix_struct, name)
Creates a new full matrix with the given structure.
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_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...
DBCSR operations in CP2K.
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_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_create(matrix, matrix_struct, name, use_sp)
creates a new full matrix with the given structure
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)
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
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, 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_nonbond, sab_almo, sab_kp, sab_kp_nosym, 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, 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, ecoul_1c, rho0_s_rs, rho0_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, 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, rhs)
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)
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,...