LCOV - code coverage report
Current view: top level - src - transport.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:b977e33) Lines: 21 282 7.4 %
Date: 2024-04-12 06:52:23 Functions: 2 10 20.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief routines for DFT+NEGF calculations (coupling with the quantum transport code OMEN)
      10             : !> \par History
      11             : !>       12.2012 created external_scf_method [Hossein Bani-Hashemian]
      12             : !>       05.2013 created rotines to work with C-interoperable matrices [Hossein Bani-Hashemian]
      13             : !>       07.2013 created transport_env routines [Hossein Bani-Hashemian]
      14             : !>       11.2014 switch to CSR matrices [Hossein Bani-Hashemian]
      15             : !>       12.2014 merged [Hossein Bani-Hashemian]
      16             : !>       04.2016 added imaginary DM and current density cube [Hossein Bani-Hashemian]
      17             : !> \author Mohammad Hossein Bani-Hashemian
      18             : ! **************************************************************************************************
      19             : MODULE transport
      20             :    USE ISO_C_BINDING,                   ONLY: C_ASSOCIATED,&
      21             :                                               C_BOOL,&
      22             :                                               C_DOUBLE,&
      23             :                                               C_F_PROCPOINTER,&
      24             :                                               C_INT,&
      25             :                                               C_LOC,&
      26             :                                               C_NULL_PTR,&
      27             :                                               C_PTR
      28             :    USE atomic_kind_types,               ONLY: atomic_kind_type,&
      29             :                                               get_atomic_kind
      30             :    USE bibliography,                    ONLY: Bruck2014,&
      31             :                                               cite_reference
      32             :    USE cp_control_types,                ONLY: dft_control_type
      33             :    USE cp_dbcsr_cp2k_link,              ONLY: cp_dbcsr_to_csr_screening
      34             :    USE cp_log_handling,                 ONLY: cp_get_default_logger,&
      35             :                                               cp_logger_get_default_unit_nr,&
      36             :                                               cp_logger_type
      37             :    USE cp_output_handling,              ONLY: cp_p_file,&
      38             :                                               cp_print_key_finished_output,&
      39             :                                               cp_print_key_should_output,&
      40             :                                               cp_print_key_unit_nr
      41             :    USE cp_realspace_grid_cube,          ONLY: cp_pw_to_cube
      42             :    USE dbcsr_api,                       ONLY: &
      43             :         dbcsr_convert_csr_to_dbcsr, dbcsr_convert_dbcsr_to_csr, dbcsr_copy, &
      44             :         dbcsr_copy_into_existing, dbcsr_create, dbcsr_csr_create, dbcsr_csr_create_from_dbcsr, &
      45             :         dbcsr_csr_dbcsr_blkrow_dist, dbcsr_csr_print_sparsity, dbcsr_csr_type, &
      46             :         dbcsr_deallocate_matrix, dbcsr_desymmetrize, dbcsr_has_symmetry, dbcsr_set, dbcsr_type, &
      47             :         dbcsr_type_no_symmetry, dbcsr_type_real_8
      48             :    USE input_section_types,             ONLY: section_get_ivals,&
      49             :                                               section_vals_get,&
      50             :                                               section_vals_get_subs_vals,&
      51             :                                               section_vals_type,&
      52             :                                               section_vals_val_get
      53             :    USE kinds,                           ONLY: dp
      54             :    USE particle_list_types,             ONLY: particle_list_type
      55             :    USE particle_methods,                ONLY: get_particle_set
      56             :    USE particle_types,                  ONLY: particle_type
      57             :    USE physcon,                         ONLY: boltzmann,&
      58             :                                               e_charge,&
      59             :                                               evolt,&
      60             :                                               h_bar
      61             :    USE pw_env_types,                    ONLY: pw_env_get,&
      62             :                                               pw_env_type
      63             :    USE pw_methods,                      ONLY: pw_zero
      64             :    USE pw_pool_types,                   ONLY: pw_pool_type
      65             :    USE pw_types,                        ONLY: pw_c1d_gs_type,&
      66             :                                               pw_r3d_rs_type
      67             :    USE qs_environment_types,            ONLY: get_qs_env,&
      68             :                                               qs_environment_type,&
      69             :                                               set_qs_env
      70             :    USE qs_kind_types,                   ONLY: get_qs_kind,&
      71             :                                               qs_kind_type
      72             :    USE qs_ks_types,                     ONLY: qs_ks_env_type
      73             :    USE qs_linres_current,               ONLY: calculate_jrho_resp
      74             :    USE qs_linres_types,                 ONLY: current_env_type
      75             :    USE qs_rho_types,                    ONLY: qs_rho_get,&
      76             :                                               qs_rho_type
      77             :    USE qs_subsys_types,                 ONLY: qs_subsys_get,&
      78             :                                               qs_subsys_type
      79             :    USE transport_env_types,             ONLY: cp2k_csr_interop_type,&
      80             :                                               cp2k_transport_parameters,&
      81             :                                               csr_interop_matrix_get_info,&
      82             :                                               csr_interop_nullify,&
      83             :                                               transport_env_type
      84             : #include "./base/base_uses.f90"
      85             : 
      86             :    IMPLICIT NONE
      87             : 
      88             :    PRIVATE
      89             : 
      90             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'transport'
      91             : 
      92             :    PUBLIC :: transport_env_create, transport_initialize, external_scf_method
      93             :    PUBLIC :: qs_scf_post_transport
      94             : 
      95             : !> interface between C/C++ and FORTRAN
      96             :    INTERFACE c_func_interface
      97             : ! **************************************************************************************************
      98             : !> \brief C routine that takes the S and H matrices as input and outputs a P matrix
      99             : !> \param cp2k_transport_params transport parameters read form a CP2K input file
     100             : !> \param s_mat  C-interoperable overlap matrix
     101             : !> \param ks_mat C-interoperable Kohn-Sham matrix
     102             : !> \param p_mat  C-interoperable density matrix
     103             : !> \param imagp_mat C-interoperable imaginary density matrix
     104             : !> \author Mohammad Hossein Bani-Hashemian
     105             : ! **************************************************************************************************
     106             :       SUBROUTINE c_scf_routine(cp2k_transport_params, s_mat, ks_mat, p_mat, imagp_mat) BIND(C)
     107             :          IMPORT :: C_INT, C_PTR, cp2k_csr_interop_type, cp2k_transport_parameters
     108             :          IMPLICIT NONE
     109             :          TYPE(cp2k_transport_parameters), VALUE, INTENT(IN) :: cp2k_transport_params
     110             :          TYPE(cp2k_csr_interop_type), VALUE, INTENT(IN)     :: s_mat
     111             :          TYPE(cp2k_csr_interop_type), VALUE, INTENT(IN)     :: ks_mat
     112             :          TYPE(cp2k_csr_interop_type), INTENT(INOUT)         :: p_mat
     113             :          TYPE(cp2k_csr_interop_type), INTENT(INOUT)         :: imagp_mat
     114             :       END SUBROUTINE c_scf_routine
     115             :    END INTERFACE c_func_interface
     116             : 
     117             : CONTAINS
     118             : 
     119             : ! **************************************************************************************************
     120             : !> \brief creates the transport environment
     121             : !> \param[inout] qs_env the qs_env containing the transport_env
     122             : !> \author Mohammad Hossein Bani-Hashemian
     123             : ! **************************************************************************************************
     124           0 :    SUBROUTINE transport_env_create(qs_env)
     125             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     126             : 
     127             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'transport_env_create'
     128             : 
     129             :       INTEGER                                            :: handle
     130             :       TYPE(dft_control_type), POINTER                    :: dft_control
     131             :       TYPE(section_vals_type), POINTER                   :: input
     132             :       TYPE(transport_env_type), POINTER                  :: transport_env
     133             : 
     134           0 :       CALL timeset(routineN, handle)
     135             : 
     136             :       CALL get_qs_env(qs_env, &
     137             :                       transport_env=transport_env, &
     138             :                       dft_control=dft_control, &
     139           0 :                       input=input)
     140             : 
     141           0 :       CPASSERT(.NOT. ASSOCIATED(transport_env))
     142             : 
     143           0 :       ALLOCATE (transport_env)
     144             : 
     145           0 :       CALL transport_init_read_input(input, transport_env)
     146           0 :       CALL transport_set_contact_params(qs_env, transport_env)
     147             : 
     148           0 :       CALL set_qs_env(qs_env, transport_env=transport_env)
     149             : 
     150           0 :       CALL timestop(handle)
     151             : 
     152           0 :    END SUBROUTINE transport_env_create
     153             : 
     154             : ! **************************************************************************************************
     155             : !> \brief intitializes all fields of transport_env using the parameters read from
     156             : !>        the corresponding input section
     157             : !> \param[inout] input         the input file
     158             : !> \param[inout] transport_env the transport_env to be initialized
     159             : !> \author Mohammad Hossein Bani-Hashemian
     160             : ! **************************************************************************************************
     161           0 :    SUBROUTINE transport_init_read_input(input, transport_env)
     162             :       TYPE(section_vals_type), POINTER                   :: input
     163             :       TYPE(transport_env_type), INTENT(INOUT)            :: transport_env
     164             : 
     165             :       CHARACTER(len=*), PARAMETER :: routineN = 'transport_init_read_input'
     166             : 
     167             :       INTEGER                                            :: contact_bandwidth, contact_injsign, &
     168             :                                                             contact_natoms, contact_start, handle, &
     169             :                                                             i, n_contacts, stride_contacts
     170           0 :       INTEGER, DIMENSION(:), POINTER                     :: i_vals
     171             :       LOGICAL                                            :: contact_explicit, injecting_contact, &
     172             :                                                             obc_equilibrium, one_circle
     173             :       TYPE(section_vals_type), POINTER                   :: beyn_section, contact_section, &
     174             :                                                             pexsi_section, transport_section
     175             : 
     176           0 :       CALL timeset(routineN, handle)
     177             : 
     178           0 :       transport_section => section_vals_get_subs_vals(input, "DFT%TRANSPORT")
     179           0 :       contact_section => section_vals_get_subs_vals(transport_section, "CONTACT")
     180           0 :       beyn_section => section_vals_get_subs_vals(transport_section, "BEYN")
     181           0 :       pexsi_section => section_vals_get_subs_vals(transport_section, "PEXSI")
     182           0 :       CALL section_vals_get(contact_section, explicit=contact_explicit, n_repetition=n_contacts)
     183             : 
     184           0 :       NULLIFY (i_vals)
     185             : ! read from input
     186           0 :       CALL section_vals_val_get(transport_section, "TRANSPORT_METHOD", i_val=transport_env%params%method)
     187           0 :       CALL section_vals_val_get(transport_section, "INJECTION_METHOD", i_val=transport_env%params%injection_method)
     188             :       CALL section_vals_val_get(transport_section, "REAL_AXIS_INTEGRATION_METHOD", &
     189           0 :                                 i_val=transport_env%params%rlaxis_integration_method)
     190           0 :       CALL section_vals_val_get(transport_section, "QT_FORMALISM", i_val=transport_env%params%qt_formalism)
     191           0 :       CALL section_vals_val_get(transport_section, "LINEAR_SOLVER", i_val=transport_env%params%linear_solver)
     192             :       CALL section_vals_val_get(transport_section, "MATRIX_INVERSION_METHOD", &
     193           0 :                                 i_val=transport_env%params%matrixinv_method)
     194           0 :       CALL section_vals_val_get(transport_section, "CONTACT_FILLING", i_val=transport_env%params%transport_neutral)
     195           0 :       CALL section_vals_val_get(transport_section, "N_KPOINTS", i_val=transport_env%params%n_kpoint)
     196           0 :       CALL section_vals_val_get(transport_section, "NUM_INTERVAL", i_val=transport_env%params%num_interval)
     197             :       CALL section_vals_val_get(transport_section, "TASKS_PER_ENERGY_POINT", &
     198           0 :                                 i_val=transport_env%params%tasks_per_energy_point)
     199           0 :       CALL section_vals_val_get(transport_section, "TASKS_PER_POLE", i_val=transport_env%params%tasks_per_pole)
     200           0 :       CALL section_vals_val_get(transport_section, "NUM_POLE", i_val=transport_env%params%num_pole)
     201           0 :       CALL section_vals_val_get(transport_section, "GPUS_PER_POINT", i_val=transport_env%params%gpus_per_point)
     202           0 :       CALL section_vals_val_get(transport_section, "N_POINTS_INV", i_val=transport_env%params%n_points_inv)
     203           0 :       CALL section_vals_val_get(transport_section, "COLZERO_THRESHOLD", r_val=transport_env%params%colzero_threshold)
     204           0 :       CALL section_vals_val_get(transport_section, "EPS_LIMIT", r_val=transport_env%params%eps_limit)
     205           0 :       CALL section_vals_val_get(transport_section, "EPS_LIMIT_CC", r_val=transport_env%params%eps_limit_cc)
     206           0 :       CALL section_vals_val_get(transport_section, "EPS_DECAY", r_val=transport_env%params%eps_decay)
     207             :       CALL section_vals_val_get(transport_section, "EPS_SINGULARITY_CURVATURES", &
     208           0 :                                 r_val=transport_env%params%eps_singularity_curvatures)
     209           0 :       CALL section_vals_val_get(transport_section, "EPS_MU", r_val=transport_env%params%eps_mu)
     210           0 :       CALL section_vals_val_get(transport_section, "EPS_EIGVAL_DEGEN", r_val=transport_env%params%eps_eigval_degen)
     211           0 :       CALL section_vals_val_get(transport_section, "EPS_FERMI", r_val=transport_env%params%eps_fermi)
     212           0 :       CALL section_vals_val_get(transport_section, "ENERGY_INTERVAL", r_val=transport_env%params%energy_interval)
     213           0 :       CALL section_vals_val_get(transport_section, "MIN_INTERVAL", r_val=transport_env%params%min_interval)
     214           0 :       CALL section_vals_val_get(transport_section, "TEMPERATURE", r_val=transport_env%params%temperature)
     215           0 :       CALL section_vals_val_get(transport_section, "DENSITY_MIXING", r_val=transport_env%params%dens_mixing)
     216           0 :       CALL section_vals_val_get(transport_section, "CSR_SCREENING", l_val=transport_env%csr_screening)
     217             : 
     218             :       ! logical*1 to logical*4 , l_val is logical*1 and c_bool is equivalent to logical*4
     219           0 :       CALL section_vals_val_get(transport_section, "OBC_EQUILIBRIUM", l_val=obc_equilibrium)
     220           0 :       IF (obc_equilibrium) THEN
     221           0 :          transport_env%params%obc_equilibrium = .TRUE.
     222             :       ELSE
     223           0 :          transport_env%params%obc_equilibrium = .FALSE.
     224             :       END IF
     225             : 
     226           0 :       CALL section_vals_val_get(transport_section, "CUTOUT", i_vals=i_vals)
     227           0 :       transport_env%params%cutout = i_vals
     228             : 
     229             :       CALL section_vals_val_get(beyn_section, "TASKS_PER_INTEGRATION_POINT", &
     230           0 :                                 i_val=transport_env%params%tasks_per_integration_point)
     231           0 :       CALL section_vals_val_get(beyn_section, "N_POINTS_BEYN", i_val=transport_env%params%n_points_beyn)
     232           0 :       CALL section_vals_val_get(beyn_section, "N_RAND", r_val=transport_env%params%n_rand_beyn)
     233           0 :       CALL section_vals_val_get(beyn_section, "N_RAND_CC", r_val=transport_env%params%n_rand_cc_beyn)
     234           0 :       CALL section_vals_val_get(beyn_section, "SVD_CUTOFF", r_val=transport_env%params%svd_cutoff)
     235           0 :       CALL section_vals_val_get(beyn_section, "ONE_CIRCLE", l_val=one_circle)
     236           0 :       IF (one_circle) THEN
     237           0 :          transport_env%params%ncrc_beyn = 1
     238             :       ELSE
     239           0 :          transport_env%params%ncrc_beyn = 2
     240             :       END IF
     241             : 
     242           0 :       CALL section_vals_val_get(pexsi_section, "ORDERING", i_val=transport_env%params%ordering)
     243           0 :       CALL section_vals_val_get(pexsi_section, "ROW_ORDERING", i_val=transport_env%params%row_ordering)
     244           0 :       CALL section_vals_val_get(pexsi_section, "VERBOSITY", i_val=transport_env%params%verbosity)
     245           0 :       CALL section_vals_val_get(pexsi_section, "NP_SYMB_FACT", i_val=transport_env%params%pexsi_np_symb_fact)
     246             : 
     247           0 :       IF (contact_explicit) THEN
     248           0 :          transport_env%params%num_contacts = n_contacts
     249           0 :          stride_contacts = 5
     250           0 :          transport_env%params%stride_contacts = stride_contacts
     251           0 :          ALLOCATE (transport_env%contacts_data(stride_contacts*n_contacts))
     252             : 
     253           0 :          DO i = 1, n_contacts
     254           0 :             CALL section_vals_val_get(contact_section, "BANDWIDTH", i_rep_section=i, i_val=contact_bandwidth)
     255           0 :             CALL section_vals_val_get(contact_section, "START", i_rep_section=i, i_val=contact_start)
     256           0 :             CALL section_vals_val_get(contact_section, "N_ATOMS", i_rep_section=i, i_val=contact_natoms)
     257           0 :             CALL section_vals_val_get(contact_section, "INJECTION_SIGN", i_rep_section=i, i_val=contact_injsign)
     258           0 :             CALL section_vals_val_get(contact_section, "INJECTING_CONTACT", i_rep_section=i, l_val=injecting_contact)
     259             : 
     260           0 :             IF (contact_natoms .LE. 0) CPABORT("Number of atoms in contact region needs to be defined.")
     261             : 
     262           0 :             transport_env%contacts_data((i - 1)*stride_contacts + 1) = contact_bandwidth
     263           0 :             transport_env%contacts_data((i - 1)*stride_contacts + 2) = contact_start - 1 ! C indexing
     264           0 :             transport_env%contacts_data((i - 1)*stride_contacts + 3) = contact_natoms
     265           0 :             transport_env%contacts_data((i - 1)*stride_contacts + 4) = contact_injsign
     266             : 
     267           0 :             IF (injecting_contact) THEN
     268           0 :                transport_env%contacts_data((i - 1)*stride_contacts + 5) = 1
     269             :             ELSE
     270           0 :                transport_env%contacts_data((i - 1)*stride_contacts + 5) = 0
     271             :             END IF
     272             :          END DO
     273           0 :          transport_env%params%contacts_data = C_LOC(transport_env%contacts_data(1))
     274             :       ELSE
     275           0 :          CPABORT("No contact region is defined.")
     276             :       END IF
     277             : 
     278           0 :       CALL timestop(handle)
     279             : 
     280           0 :    END SUBROUTINE transport_init_read_input
     281             : 
     282             : ! **************************************************************************************************
     283             : !> \brief initializes the transport environment
     284             : !> \param ks_env ...
     285             : !> \param[inout] transport_env the transport env to be initialized
     286             : !> \param[in]    template_matrix   template matrix to keep the sparsity of matrices fixed
     287             : !> \author Mohammad Hossein Bani-Hashemian
     288             : ! **************************************************************************************************
     289           0 :    SUBROUTINE transport_initialize(ks_env, transport_env, template_matrix)
     290             :       TYPE(qs_ks_env_type), POINTER                      :: ks_env
     291             :       TYPE(transport_env_type), INTENT(INOUT)            :: transport_env
     292             :       TYPE(dbcsr_type), INTENT(IN)                       :: template_matrix
     293             : 
     294             :       CHARACTER(len=*), PARAMETER :: routineN = 'transport_initialize'
     295             : 
     296             :       INTEGER                                            :: handle, numnodes, unit_nr
     297             :       TYPE(cp_logger_type), POINTER                      :: logger
     298             : 
     299           0 :       CALL timeset(routineN, handle)
     300             : 
     301           0 :       CALL cite_reference(Bruck2014)
     302             : 
     303           0 :       logger => cp_get_default_logger()
     304           0 :       IF (logger%para_env%is_source()) THEN
     305           0 :          unit_nr = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
     306             :       ELSE
     307           0 :          unit_nr = -1
     308             :       END IF
     309             : 
     310           0 :       numnodes = logger%para_env%num_pe
     311             : 
     312           0 :       IF (dbcsr_has_symmetry(template_matrix)) THEN
     313           0 :          CALL dbcsr_copy(transport_env%template_matrix_sym, template_matrix)
     314           0 :          CALL dbcsr_desymmetrize(transport_env%template_matrix_sym, transport_env%template_matrix_nosym)
     315             :       ELSE
     316           0 :          CALL dbcsr_copy(transport_env%template_matrix_nosym, template_matrix)
     317           0 :          CALL dbcsr_copy(transport_env%template_matrix_sym, template_matrix)
     318             :       END IF
     319             : 
     320           0 :       ALLOCATE (transport_env%dm_imag)
     321             :       CALL dbcsr_create(transport_env%dm_imag, "imaginary DM", &
     322           0 :                         template=template_matrix, matrix_type=dbcsr_type_no_symmetry)
     323           0 :       CALL dbcsr_set(transport_env%dm_imag, 0.0_dp)
     324             : 
     325             :       CALL dbcsr_create(transport_env%csr_sparsity, "CSR sparsity", &
     326             :                         template=transport_env%template_matrix_sym, &
     327           0 :                         data_type=dbcsr_type_real_8)
     328           0 :       CALL dbcsr_copy(transport_env%csr_sparsity, transport_env%template_matrix_sym)
     329             : 
     330           0 :       CALL cp_dbcsr_to_csr_screening(ks_env, transport_env%csr_sparsity)
     331             : 
     332           0 :       IF (.NOT. transport_env%csr_screening) CALL dbcsr_set(transport_env%csr_sparsity, 1.0)
     333             :       CALL dbcsr_csr_create_from_dbcsr(transport_env%template_matrix_nosym, &
     334             :                                        transport_env%s_matrix, &
     335             :                                        dbcsr_csr_dbcsr_blkrow_dist, &
     336             :                                        csr_sparsity=transport_env%csr_sparsity, &
     337           0 :                                        numnodes=numnodes)
     338             : 
     339           0 :       CALL dbcsr_csr_print_sparsity(transport_env%s_matrix, unit_nr)
     340             : 
     341           0 :       CALL dbcsr_convert_dbcsr_to_csr(transport_env%template_matrix_nosym, transport_env%s_matrix)
     342             : 
     343           0 :       CALL dbcsr_csr_create(transport_env%ks_matrix, transport_env%s_matrix)
     344           0 :       CALL dbcsr_csr_create(transport_env%p_matrix, transport_env%s_matrix)
     345           0 :       CALL dbcsr_csr_create(transport_env%imagp_matrix, transport_env%s_matrix)
     346             : 
     347           0 :       CALL timestop(handle)
     348             : 
     349           0 :    END SUBROUTINE transport_initialize
     350             : 
     351             : ! **************************************************************************************************
     352             : !> \brief SCF calcualtion with an externally evaluated density matrix
     353             : !> \param[inout] transport_env  transport environment
     354             : !> \param[in]    matrix_s       DBCSR overlap matrix
     355             : !> \param[in]    matrix_ks      DBCSR Kohn-Sham matrix
     356             : !> \param[inout] matrix_p       DBCSR density matrix
     357             : !> \param[in]    nelectron_spin number of electrons
     358             : !> \param[in]    natoms         number of atoms
     359             : !> \param[in]    energy_diff    scf energy difference
     360             : !> \param[in]    iscf           the current scf iteration
     361             : !> \param[in]    extra_scf      whether or not an extra scf step will be performed
     362             : !> \par History
     363             : !>       12.2012 created [Hossein Bani-Hashemian]
     364             : !>       12.2014 revised [Hossein Bani-Hashemian]
     365             : !> \author Mohammad Hossein Bani-Hashemian
     366             : ! **************************************************************************************************
     367           0 :    SUBROUTINE external_scf_method(transport_env, matrix_s, matrix_ks, matrix_p, &
     368             :                                   nelectron_spin, natoms, energy_diff, iscf, extra_scf)
     369             : 
     370             :       TYPE(transport_env_type), INTENT(INOUT)            :: transport_env
     371             :       TYPE(dbcsr_type), INTENT(IN)                       :: matrix_s, matrix_ks
     372             :       TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix_p
     373             :       INTEGER, INTENT(IN)                                :: nelectron_spin, natoms
     374             :       REAL(dp), INTENT(IN)                               :: energy_diff
     375             :       INTEGER, INTENT(IN)                                :: iscf
     376             :       LOGICAL, INTENT(IN)                                :: extra_scf
     377             : 
     378             :       CHARACTER(len=*), PARAMETER :: routineN = 'external_scf_method'
     379             : 
     380             :       TYPE(cp2k_csr_interop_type)                        :: imagp_mat, ks_mat, p_mat, s_mat
     381             : 
     382             :       PROCEDURE(c_scf_routine), POINTER        :: c_method
     383             :       INTEGER                                  :: handle
     384             : 
     385           0 :       CALL timeset(routineN, handle)
     386             : 
     387           0 :       CALL C_F_PROCPOINTER(transport_env%ext_c_method_ptr, c_method)
     388           0 :       IF (.NOT. C_ASSOCIATED(transport_env%ext_c_method_ptr)) &
     389             :          CALL cp_abort(__LOCATION__, &
     390             :                        "MISSING C/C++ ROUTINE: The TRANSPORT section is meant to be used together with an external "// &
     391           0 :                        "program, e.g. the quantum transport code OMEN, that provides CP2K with a density matrix.")
     392             : 
     393           0 :       transport_env%params%n_occ = nelectron_spin
     394           0 :       transport_env%params%n_atoms = natoms
     395           0 :       transport_env%params%energy_diff = energy_diff
     396           0 :       transport_env%params%evoltfactor = evolt
     397           0 :       transport_env%params%e_charge = e_charge
     398           0 :       transport_env%params%boltzmann = boltzmann
     399           0 :       transport_env%params%h_bar = h_bar
     400           0 :       transport_env%params%iscf = iscf
     401           0 :       transport_env%params%extra_scf = LOGICAL(extra_scf, C_BOOL) ! C_BOOL and Fortran logical don't have the same size
     402             : 
     403           0 :       CALL csr_interop_nullify(s_mat)
     404           0 :       CALL csr_interop_nullify(ks_mat)
     405           0 :       CALL csr_interop_nullify(p_mat)
     406           0 :       CALL csr_interop_nullify(imagp_mat)
     407             : 
     408           0 :       CALL dbcsr_copy_into_existing(transport_env%template_matrix_sym, matrix_s)
     409           0 :       CALL convert_dbcsr_to_csr_interop(transport_env%template_matrix_sym, transport_env%s_matrix, s_mat)
     410             : 
     411           0 :       CALL dbcsr_copy_into_existing(transport_env%template_matrix_sym, matrix_ks)
     412           0 :       CALL convert_dbcsr_to_csr_interop(transport_env%template_matrix_sym, transport_env%ks_matrix, ks_mat)
     413             : 
     414           0 :       CALL dbcsr_copy_into_existing(transport_env%template_matrix_sym, matrix_p)
     415           0 :       CALL convert_dbcsr_to_csr_interop(transport_env%template_matrix_sym, transport_env%p_matrix, p_mat)
     416             : 
     417           0 :       CALL dbcsr_copy_into_existing(transport_env%template_matrix_sym, matrix_s)
     418           0 :       CALL convert_dbcsr_to_csr_interop(transport_env%template_matrix_sym, transport_env%imagp_matrix, imagp_mat)
     419             : 
     420           0 :       CALL c_method(transport_env%params, s_mat, ks_mat, p_mat, imagp_mat)
     421             : 
     422           0 :       CALL convert_csr_interop_to_dbcsr(p_mat, transport_env%p_matrix, transport_env%template_matrix_nosym)
     423           0 :       CALL dbcsr_copy(matrix_p, transport_env%template_matrix_nosym)
     424             : 
     425           0 :       CALL convert_csr_interop_to_dbcsr(imagp_mat, transport_env%imagp_matrix, transport_env%template_matrix_nosym)
     426           0 :       CALL dbcsr_copy(transport_env%dm_imag, transport_env%template_matrix_nosym)
     427             : 
     428           0 :       CALL timestop(handle)
     429             : 
     430           0 :    END SUBROUTINE external_scf_method
     431             : 
     432             : ! **************************************************************************************************
     433             : !> \brief converts a DBCSR matrix to a C-interoperable CSR matrix
     434             : !> \param[in]    dbcsr_mat  DBCSR matrix to be converted
     435             : !> \param[inout] csr_mat    auxiliary CSR matrix
     436             : !> \param[inout] csr_interop_mat C-interoperable CSR matrix
     437             : !> \author Mohammad Hossein Bani-Hashemian
     438             : ! **************************************************************************************************
     439           0 :    SUBROUTINE convert_dbcsr_to_csr_interop(dbcsr_mat, csr_mat, csr_interop_mat)
     440             : 
     441             :       TYPE(dbcsr_type), INTENT(IN)          :: dbcsr_mat
     442             :       TYPE(dbcsr_csr_type), INTENT(INOUT)            :: csr_mat
     443             :       TYPE(cp2k_csr_interop_type), INTENT(INOUT)      :: csr_interop_mat
     444             : 
     445             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'convert_dbcsr_to_csr_interop'
     446             : 
     447             :       INTEGER                                  :: handle
     448           0 :       INTEGER, ALLOCATABLE, DIMENSION(:)       :: nrows_local_all, first_row_all
     449           0 :       INTEGER(C_INT), DIMENSION(:), POINTER    :: colind_local, rowptr_local, nzerow_local
     450           0 :       REAL(C_DOUBLE), DIMENSION(:), POINTER    :: nzvals_local
     451             :       TYPE(cp_logger_type), POINTER            :: logger
     452             : 
     453           0 :       CALL timeset(routineN, handle)
     454             : 
     455           0 :       logger => cp_get_default_logger()
     456             : 
     457             : ! dbcsr to csr
     458           0 :       CALL dbcsr_convert_dbcsr_to_csr(dbcsr_mat, csr_mat)
     459             : 
     460             : ! csr to csr_interop
     461           0 :       rowptr_local => csr_mat%rowptr_local
     462           0 :       colind_local => csr_mat%colind_local
     463           0 :       nzerow_local => csr_mat%nzerow_local
     464           0 :       nzvals_local => csr_mat%nzval_local%r_dp ! support real double percision for now
     465             : 
     466           0 :       IF (SIZE(rowptr_local) .EQ. 0) THEN
     467           0 :          csr_interop_mat%rowptr_local = C_NULL_PTR
     468             :       ELSE
     469           0 :          csr_interop_mat%rowptr_local = C_LOC(rowptr_local(1))
     470             :       END IF
     471             : 
     472           0 :       IF (SIZE(colind_local) .EQ. 0) THEN
     473           0 :          csr_interop_mat%colind_local = C_NULL_PTR
     474             :       ELSE
     475           0 :          csr_interop_mat%colind_local = C_LOC(colind_local(1))
     476             :       END IF
     477             : 
     478           0 :       IF (SIZE(nzerow_local) .EQ. 0) THEN
     479           0 :          csr_interop_mat%nzerow_local = C_NULL_PTR
     480             :       ELSE
     481           0 :          csr_interop_mat%nzerow_local = C_LOC(nzerow_local(1))
     482             :       END IF
     483             : 
     484           0 :       IF (SIZE(nzvals_local) .EQ. 0) THEN
     485           0 :          csr_interop_mat%nzvals_local = C_NULL_PTR
     486             :       ELSE
     487           0 :          csr_interop_mat%nzvals_local = C_LOC(nzvals_local(1))
     488             :       END IF
     489             : 
     490             :       ASSOCIATE (mp_group => logger%para_env, mepos => logger%para_env%mepos, num_pe => logger%para_env%num_pe)
     491           0 :          ALLOCATE (nrows_local_all(0:num_pe - 1), first_row_all(0:num_pe - 1))
     492           0 :          CALL mp_group%allgather(csr_mat%nrows_local, nrows_local_all)
     493           0 :          CALL cumsum_i(nrows_local_all, first_row_all)
     494             : 
     495           0 :          IF (mepos .EQ. 0) THEN
     496           0 :             csr_interop_mat%first_row = 0
     497             :          ELSE
     498           0 :             csr_interop_mat%first_row = first_row_all(mepos - 1)
     499             :          END IF
     500             :       END ASSOCIATE
     501           0 :       csr_interop_mat%nrows_total = csr_mat%nrows_total
     502           0 :       csr_interop_mat%ncols_total = csr_mat%ncols_total
     503           0 :       csr_interop_mat%nze_local = csr_mat%nze_local
     504           0 :       IF (csr_mat%nze_total > HUGE(csr_interop_mat%nze_total)) THEN
     505           0 :          CPABORT("overflow in nze")
     506             :       END IF
     507           0 :       csr_interop_mat%nze_total = INT(csr_mat%nze_total, KIND=KIND(csr_interop_mat%nze_total))
     508           0 :       csr_interop_mat%nrows_local = csr_mat%nrows_local
     509           0 :       csr_interop_mat%data_type = csr_mat%nzval_local%data_type
     510             : 
     511           0 :       CALL timestop(handle)
     512             : 
     513             :    CONTAINS
     514             : ! **************************************************************************************************
     515             : !> \brief cumulative sum of a 1d array of integers
     516             : !> \param[in]  arr    input array
     517             : !> \param[out] cumsum cumulative sum of the input array
     518             : ! **************************************************************************************************
     519           0 :       SUBROUTINE cumsum_i(arr, cumsum)
     520             :       INTEGER, DIMENSION(:), INTENT(IN)                  :: arr
     521             :       INTEGER, DIMENSION(SIZE(arr)), INTENT(OUT)         :: cumsum
     522             : 
     523             :       INTEGER                                            :: i
     524             : 
     525           0 :          cumsum(1) = arr(1)
     526           0 :          DO i = 2, SIZE(arr)
     527           0 :             cumsum(i) = cumsum(i - 1) + arr(i)
     528             :          END DO
     529           0 :       END SUBROUTINE cumsum_i
     530             : 
     531             :    END SUBROUTINE convert_dbcsr_to_csr_interop
     532             : 
     533             : ! **************************************************************************************************
     534             : !> \brief converts a C-interoperable CSR matrix to a DBCSR matrix
     535             : !> \param[in] csr_interop_mat C-interoperable CSR matrix
     536             : !> \param[inout] csr_mat         auxiliary CSR matrix
     537             : !> \param[inout] dbcsr_mat       DBCSR matrix
     538             : !> \author Mohammad Hossein Bani-Hashemian
     539             : ! **************************************************************************************************
     540           0 :    SUBROUTINE convert_csr_interop_to_dbcsr(csr_interop_mat, csr_mat, dbcsr_mat)
     541             : 
     542             :       TYPE(cp2k_csr_interop_type), INTENT(IN)            :: csr_interop_mat
     543             :       TYPE(dbcsr_csr_type), INTENT(INOUT)                      :: csr_mat
     544             :       TYPE(dbcsr_type), INTENT(INOUT)                    :: dbcsr_mat
     545             : 
     546             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'convert_csr_interop_to_dbcsr'
     547             : 
     548             :       INTEGER                                            :: data_type, handle, ncols_total, &
     549             :                                                             nrows_local, nrows_total, nze_local, &
     550             :                                                             nze_total
     551           0 :       INTEGER, DIMENSION(:), POINTER                     :: colind_local, nzerow_local, rowptr_local
     552           0 :       REAL(dp), DIMENSION(:), POINTER                    :: nzvals_local
     553             : 
     554           0 :       CALL timeset(routineN, handle)
     555             : 
     556             : ! csr_interop to csr
     557             :       CALL csr_interop_matrix_get_info(csr_interop_mat, &
     558             :                                        nrows_total=nrows_total, ncols_total=ncols_total, nze_local=nze_local, &
     559             :                                        nze_total=nze_total, nrows_local=nrows_local, data_type=data_type, &
     560             :                                        rowptr_local=rowptr_local, colind_local=colind_local, &
     561           0 :                                        nzerow_local=nzerow_local, nzvals_local=nzvals_local)
     562             : 
     563           0 :       csr_mat%nrows_total = nrows_total
     564           0 :       csr_mat%ncols_total = ncols_total
     565           0 :       csr_mat%nze_local = nze_local
     566           0 :       csr_mat%nze_total = nze_total
     567           0 :       csr_mat%nrows_local = nrows_local
     568           0 :       csr_mat%nzval_local%data_type = data_type
     569             : 
     570           0 :       csr_mat%rowptr_local = rowptr_local
     571           0 :       csr_mat%colind_local = colind_local
     572           0 :       csr_mat%nzerow_local = nzerow_local
     573           0 :       csr_mat%nzval_local%r_dp = nzvals_local
     574             : 
     575             : ! csr to dbcsr
     576           0 :       CALL dbcsr_convert_csr_to_dbcsr(dbcsr_mat, csr_mat)
     577             : 
     578           0 :       CALL timestop(handle)
     579             : 
     580           0 :    END SUBROUTINE convert_csr_interop_to_dbcsr
     581             : 
     582             : ! **************************************************************************************************
     583             : !> \brief extraxts zeff (effective nuclear charges per atom) and nsgf (the size
     584             : !>   of spherical Gaussian basis functions per atom) from qs_env and initializes
     585             : !>   the corresponding arrays in transport_env%params
     586             : !> \param[in] qs_env qs environment
     587             : !> \param[inout] transport_env transport environment
     588             : !> \author Mohammad Hossein Bani-Hashemian
     589             : ! **************************************************************************************************
     590           0 :    SUBROUTINE transport_set_contact_params(qs_env, transport_env)
     591             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     592             :       TYPE(transport_env_type), INTENT(INOUT)            :: transport_env
     593             : 
     594             :       INTEGER                                            :: i, iat, ikind, natom, nkind
     595           0 :       INTEGER, DIMENSION(:), POINTER                     :: atom_list
     596             :       REAL(KIND=dp)                                      :: zeff
     597           0 :       TYPE(atomic_kind_type), DIMENSION(:), POINTER      :: atomic_kind_set
     598             :       TYPE(atomic_kind_type), POINTER                    :: atomic_kind
     599           0 :       TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
     600           0 :       TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
     601             : 
     602           0 :       CALL get_qs_env(qs_env, nkind=nkind, natom=natom)
     603             :       CALL get_qs_env(qs_env, particle_set=particle_set, &
     604             :                       qs_kind_set=qs_kind_set, &
     605           0 :                       atomic_kind_set=atomic_kind_set)
     606             : 
     607           0 :       ALLOCATE (transport_env%nsgf(natom))
     608           0 :       ALLOCATE (transport_env%zeff(natom))
     609           0 :       CALL get_particle_set(particle_set, qs_kind_set, nsgf=transport_env%nsgf)
     610             : 
     611             :       ! reference charges
     612           0 :       DO ikind = 1, nkind
     613           0 :          CALL get_qs_kind(qs_kind_set(ikind), zeff=zeff)
     614           0 :          atomic_kind => atomic_kind_set(ikind)
     615           0 :          CALL get_atomic_kind(atomic_kind, atom_list=atom_list)
     616           0 :          DO iat = 1, SIZE(atom_list)
     617           0 :             i = atom_list(iat)
     618           0 :             transport_env%zeff(i) = zeff
     619             :          END DO
     620             :       END DO
     621             : 
     622           0 :       IF (natom .EQ. 0) THEN
     623           0 :          transport_env%params%nsgf = C_NULL_PTR
     624           0 :          transport_env%params%zeff = C_NULL_PTR
     625             :       ELSE
     626           0 :          transport_env%params%nsgf = C_LOC(transport_env%nsgf(1))
     627           0 :          transport_env%params%zeff = C_LOC(transport_env%zeff(1))
     628             :       END IF
     629             : 
     630           0 :    END SUBROUTINE transport_set_contact_params
     631             : 
     632             : !**************************************************************************************************
     633             : !> \brief evaluates current density using the imaginary part of the density matrix and prints it
     634             : !>        into cube files
     635             : !> \param[in] input the input
     636             : !> \param[in] qs_env qs environment
     637             : !> \author Mohammad Hossein Bani-Hashemian
     638             : ! **************************************************************************************************
     639       10785 :    SUBROUTINE transport_current(input, qs_env)
     640             :       TYPE(section_vals_type), POINTER                   :: input
     641             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     642             : 
     643             :       CHARACTER(len=*), PARAMETER                        :: routineN = 'transport_current'
     644             : 
     645             :       CHARACTER(len=14)                                  :: ext
     646             :       CHARACTER(len=2)                                   :: sdir
     647             :       INTEGER                                            :: dir, handle, unit_nr
     648             :       LOGICAL                                            :: do_current_cube, do_transport, mpi_io
     649             :       TYPE(cp_logger_type), POINTER                      :: logger
     650             :       TYPE(current_env_type)                             :: current_env
     651             :       TYPE(dbcsr_type), POINTER                          :: zero
     652             :       TYPE(dft_control_type), POINTER                    :: dft_control
     653             :       TYPE(particle_list_type), POINTER                  :: particles
     654             :       TYPE(pw_c1d_gs_type)                               :: gs
     655       10785 :       TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER        :: rho_g
     656             :       TYPE(pw_env_type), POINTER                         :: pw_env
     657             :       TYPE(pw_pool_type), POINTER                        :: auxbas_pw_pool
     658             :       TYPE(pw_r3d_rs_type)                               :: rs
     659       10785 :       TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER        :: rho_r
     660             :       TYPE(qs_rho_type), POINTER                         :: rho
     661             :       TYPE(qs_subsys_type), POINTER                      :: subsys
     662             :       TYPE(section_vals_type), POINTER                   :: dft_section
     663             :       TYPE(transport_env_type), POINTER                  :: transport_env
     664             : 
     665       10785 :       CALL timeset(routineN, handle)
     666             : 
     667       10785 :       logger => cp_get_default_logger()
     668       10785 :       dft_section => section_vals_get_subs_vals(input, "DFT")
     669             :       CALL get_qs_env(qs_env=qs_env, &
     670             :                       subsys=subsys, &
     671             :                       pw_env=pw_env, &
     672             :                       transport_env=transport_env, &
     673             :                       do_transport=do_transport, &
     674             :                       dft_control=dft_control, &
     675       10785 :                       rho=rho)
     676       10785 :       CALL qs_subsys_get(subsys, particles=particles)
     677       10785 :       CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
     678       10785 :       CALL qs_rho_get(rho, rho_r=rho_r, rho_g=rho_g)
     679             : 
     680             :       do_current_cube = BTEST(cp_print_key_should_output(logger%iter_info, input, &
     681       10785 :                                                          "DFT%TRANSPORT%PRINT%CURRENT"), cp_p_file)
     682             : 
     683             :       ! check if transport is active i.e. the imaginary dm has been actually passed to cp2k by the external code
     684       10785 :       IF (do_transport) THEN
     685           0 :          IF (C_ASSOCIATED(transport_env%ext_c_method_ptr)) THEN
     686             : 
     687             :             ! calculate_jrho_resp uses sab_all which is not associated in DFTB environment
     688           0 :             IF (dft_control%qs_control%dftb) CPABORT("Current is not available for DFTB.")
     689           0 :             IF (dft_control%qs_control%xtb) CPABORT("Current is not available for xTB.")
     690             : 
     691             :             ! now do the current
     692           0 :             IF (do_current_cube) THEN
     693           0 :                current_env%gauge = -1
     694           0 :                current_env%gauge_init = .FALSE.
     695             : 
     696           0 :                CALL auxbas_pw_pool%create_pw(rs)
     697           0 :                CALL auxbas_pw_pool%create_pw(gs)
     698             : 
     699             :                NULLIFY (zero)
     700           0 :                ALLOCATE (zero)
     701           0 :                CALL dbcsr_create(zero, template=transport_env%dm_imag)
     702           0 :                CALL dbcsr_copy(zero, transport_env%dm_imag)
     703           0 :                CALL dbcsr_set(zero, 0.0_dp)
     704             : 
     705           0 :                DO dir = 1, 3
     706           0 :                   CALL pw_zero(rs)
     707           0 :                   CALL pw_zero(gs)
     708             :                   CALL calculate_jrho_resp(zero, transport_env%dm_imag, &
     709             :                                            zero, zero, dir, dir, rs, gs, qs_env, current_env, &
     710           0 :                                            retain_rsgrid=.TRUE.)
     711           0 :                   SELECT CASE (dir)
     712             :                   CASE (1)
     713           0 :                      sdir = "-x"
     714             :                   CASE (2)
     715           0 :                      sdir = "-y"
     716             :                   CASE (3)
     717           0 :                      sdir = "-z"
     718             :                   END SELECT
     719           0 :                   ext = sdir//".cube"
     720           0 :                   mpi_io = .TRUE.
     721             :                   unit_nr = cp_print_key_unit_nr(logger, dft_section, "TRANSPORT%PRINT%CURRENT", &
     722             :                                                  extension=ext, file_status="REPLACE", file_action="WRITE", &
     723           0 :                                                  log_filename=.FALSE., mpi_io=mpi_io)
     724             :                   CALL cp_pw_to_cube(rs, unit_nr, "Transport current", particles=particles, &
     725             :                                      stride=section_get_ivals(dft_section, "TRANSPORT%PRINT%CURRENT%STRIDE"), &
     726           0 :                                      mpi_io=mpi_io)
     727             :                   CALL cp_print_key_finished_output(unit_nr, logger, dft_section, "TRANSPORT%PRINT%CURRENT", &
     728           0 :                                                     mpi_io=mpi_io)
     729             :                END DO
     730             : 
     731           0 :                CALL dbcsr_deallocate_matrix(zero)
     732           0 :                CALL auxbas_pw_pool%give_back_pw(rs)
     733           0 :                CALL auxbas_pw_pool%give_back_pw(gs)
     734             :             END IF
     735             :          END IF
     736             : 
     737             :       END IF
     738             : 
     739       10785 :       CALL timestop(handle)
     740             : 
     741      787305 :    END SUBROUTINE transport_current
     742             : 
     743             : !**************************************************************************************************
     744             : !> \brief post scf calculations for transport
     745             : !> \param[in] qs_env qs environment
     746             : !> \author Mohammad Hossein Bani-Hashemian
     747             : ! **************************************************************************************************
     748       10785 :    SUBROUTINE qs_scf_post_transport(qs_env)
     749             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     750             : 
     751             :       CHARACTER(len=*), PARAMETER :: routineN = 'qs_scf_post_transport'
     752             : 
     753             :       INTEGER                                            :: handle
     754             :       TYPE(section_vals_type), POINTER                   :: input
     755             : 
     756       10785 :       CALL timeset(routineN, handle)
     757             : 
     758       10785 :       NULLIFY (input)
     759             : 
     760             :       CALL get_qs_env(qs_env=qs_env, &
     761       10785 :                       input=input)
     762             : 
     763       10785 :       CALL transport_current(input, qs_env)
     764             : 
     765       10785 :       CALL timestop(handle)
     766             : 
     767       10785 :    END SUBROUTINE qs_scf_post_transport
     768             : 
     769             : END MODULE transport

Generated by: LCOV version 1.15