!--------------------------------------------------------------------------------------------------!
!   CP2K: A general program to perform molecular dynamics simulations                              !
!   Copyright (C) 2000 - 2018  CP2K developers group                                               !
!--------------------------------------------------------------------------------------------------!

! **************************************************************************************************
!> \brief Chemical shift calculation by dfpt
!>      Initialization of the issc_env, creation of the special neighbor lists
!>      Perturbation Hamiltonians by application of the p and rxp oprtators to  psi0
!>      Write output
!>      Deallocate everything
!> \note
!>      The psi0 should be localized
!>      the Sebastiani method works within the assumption that the orbitals are
!>      completely contained in the simulation box
! **************************************************************************************************
MODULE qs_linres_issc_utils
   USE atomic_kind_types,               ONLY: atomic_kind_type,&
                                              get_atomic_kind
   USE cell_types,                      ONLY: cell_type,&
                                              pbc
   USE cp_control_types,                ONLY: dft_control_type
   USE cp_dbcsr_cp2k_link,              ONLY: cp_dbcsr_alloc_block_from_nbl
   USE cp_dbcsr_operations,             ONLY: cp_dbcsr_sm_fm_multiply
   USE cp_fm_basic_linalg,              ONLY: cp_fm_frobenius_norm,&
                                              cp_fm_trace
   USE cp_fm_struct,                    ONLY: cp_fm_struct_create,&
                                              cp_fm_struct_release,&
                                              cp_fm_struct_type
   USE cp_fm_types,                     ONLY: cp_fm_create,&
                                              cp_fm_get_info,&
                                              cp_fm_p_type,&
                                              cp_fm_release,&
                                              cp_fm_set_all,&
                                              cp_fm_to_fm,&
                                              cp_fm_type
   USE cp_log_handling,                 ONLY: cp_get_default_logger,&
                                              cp_logger_get_default_io_unit,&
                                              cp_logger_type
   USE cp_output_handling,              ONLY: cp_p_file,&
                                              cp_print_key_finished_output,&
                                              cp_print_key_should_output,&
                                              cp_print_key_unit_nr
   USE cp_para_types,                   ONLY: cp_para_env_type
   USE dbcsr_api,                       ONLY: &
        convert_offsets_to_sizes, dbcsr_allocate_matrix_set, dbcsr_copy, dbcsr_create, &
        dbcsr_deallocate_matrix_set, dbcsr_distribution_type, dbcsr_p_type, dbcsr_set, &
        dbcsr_type_antisymmetric, dbcsr_type_symmetric
   USE input_section_types,             ONLY: section_vals_get_subs_vals,&
                                              section_vals_type,&
                                              section_vals_val_get
   USE kinds,                           ONLY: default_string_length,&
                                              dp
   USE mathlib,                         ONLY: diamat_all
   USE memory_utilities,                ONLY: reallocate
   USE particle_methods,                ONLY: get_particle_set
   USE particle_types,                  ONLY: particle_type
   USE physcon,                         ONLY: a_fine,&
                                              e_mass,&
                                              hertz,&
                                              p_mass
   USE qs_elec_field,                   ONLY: build_efg_matrix
   USE qs_environment_types,            ONLY: get_qs_env,&
                                              qs_environment_type
   USE qs_fermi_contact,                ONLY: build_fermi_contact_matrix
   USE qs_kind_types,                   ONLY: qs_kind_type
   USE qs_linres_methods,               ONLY: linres_solver
   USE qs_linres_types,                 ONLY: get_issc_env,&
                                              issc_env_create,&
                                              issc_env_type,&
                                              linres_control_type
   USE qs_matrix_pools,                 ONLY: qs_matrix_pools_type
   USE qs_mo_types,                     ONLY: get_mo_set,&
                                              mo_set_p_type
   USE qs_neighbor_list_types,          ONLY: neighbor_list_set_p_type
   USE qs_p_env_types,                  ONLY: qs_p_env_type
   USE qs_spin_orbit,                   ONLY: build_pso_matrix
#include "./base/base_uses.f90"

   IMPLICIT NONE

   PRIVATE
   PUBLIC :: issc_env_cleanup, issc_env_init, issc_response, issc_issc, issc_print

   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_linres_issc_utils'

CONTAINS

! **************************************************************************************************
!> \brief Initialize the issc environment
!> \param issc_env ...
!> \param p_env ...
!> \param qs_env ...
! **************************************************************************************************
   SUBROUTINE issc_response(issc_env, p_env, qs_env)
      !
      TYPE(issc_env_type)                                :: issc_env
      TYPE(qs_p_env_type), POINTER                       :: p_env
      TYPE(qs_environment_type), POINTER                 :: qs_env

      CHARACTER(LEN=*), PARAMETER :: routineN = 'issc_response', routineP = moduleN//':'//routineN

      INTEGER                                            :: handle, idir, ijdir, ispin, jdir, nao, &
                                                            nmo, nspins, output_unit
      LOGICAL                                            :: do_dso, do_fc, do_pso, do_sd, should_stop
      REAL(dp)                                           :: chk, fro
      TYPE(cp_fm_p_type), DIMENSION(:), POINTER          :: fc_psi0, h1_psi0, psi0_order, psi1, &
                                                            psi1_fc
      TYPE(cp_fm_p_type), DIMENSION(:, :), POINTER       :: dso_psi0, efg_psi0, psi1_dso, psi1_efg, &
                                                            psi1_pso, pso_psi0
      TYPE(cp_fm_struct_type), POINTER                   :: tmp_fm_struct
      TYPE(cp_fm_type), POINTER                          :: mo_coeff
      TYPE(cp_logger_type), POINTER                      :: logger
      TYPE(cp_para_env_type), POINTER                    :: para_env
      TYPE(dft_control_type), POINTER                    :: dft_control
      TYPE(linres_control_type), POINTER                 :: linres_control
      TYPE(mo_set_p_type), DIMENSION(:), POINTER         :: mos
      TYPE(qs_matrix_pools_type), POINTER                :: mpools
      TYPE(section_vals_type), POINTER                   :: issc_section, lr_section

      CALL timeset(routineN, handle)
      !
      NULLIFY (dft_control, linres_control, lr_section, issc_section)
      NULLIFY (logger, mpools, psi1, h1_psi0, mo_coeff, para_env)
      NULLIFY (tmp_fm_struct, psi1_fc, psi1_efg, psi1_pso, pso_psi0, fc_psi0, efg_psi0, psi0_order)

      logger => cp_get_default_logger()
      lr_section => section_vals_get_subs_vals(qs_env%input, "PROPERTIES%LINRES")
      issc_section => section_vals_get_subs_vals(qs_env%input, &
                                                 "PROPERTIES%LINRES%SPINSPIN")

      output_unit = cp_print_key_unit_nr(logger, lr_section, "PRINT%PROGRAM_RUN_INFO", &
                                         extension=".linresLog")
      IF (output_unit > 0) THEN
         WRITE (UNIT=output_unit, FMT="(T10,A,/)") &
            "*** Self consistent optimization of the response wavefunctions ***"
      ENDIF

      CALL get_qs_env(qs_env=qs_env, &
                      dft_control=dft_control, &
                      mpools=mpools, &
                      linres_control=linres_control, &
                      mos=mos, &
                      para_env=para_env)

      nspins = dft_control%nspins

      CALL get_issc_env(issc_env=issc_env, &
                        !list_cubes=list_cubes, &
                        psi1_efg=psi1_efg, &
                        psi1_pso=psi1_pso, &
                        psi1_dso=psi1_dso, &
                        psi1_fc=psi1_fc, &
                        efg_psi0=efg_psi0, &
                        pso_psi0=pso_psi0, &
                        dso_psi0=dso_psi0, &
                        fc_psi0=fc_psi0, &
                        do_fc=do_fc, &
                        do_sd=do_sd, &
                        do_pso=do_pso, &
                        do_dso=do_dso)
      !
      ! allocate the vectors
      ALLOCATE (psi0_order(nspins))
      ALLOCATE (psi1(nspins), h1_psi0(nspins))
      DO ispin = 1, nspins
         CALL get_mo_set(mo_set=mos(ispin)%mo_set, mo_coeff=mo_coeff)
         psi0_order(ispin)%matrix => mo_coeff
         CALL cp_fm_get_info(mo_coeff, ncol_global=nmo, nrow_global=nao)
         NULLIFY (tmp_fm_struct, psi1(ispin)%matrix, h1_psi0(ispin)%matrix)
         CALL cp_fm_struct_create(tmp_fm_struct, nrow_global=nao, &
                                  ncol_global=nmo, &
                                  context=mo_coeff%matrix_struct%context)
         CALL cp_fm_create(psi1(ispin)%matrix, tmp_fm_struct)
         CALL cp_fm_create(h1_psi0(ispin)%matrix, tmp_fm_struct)
         CALL cp_fm_struct_release(tmp_fm_struct)
      ENDDO
      chk = 0.0_dp
      should_stop = .FALSE.
      !
      ! operator efg
      IF (do_sd) THEN
         ijdir = 0
         DO idir = 1, 3
         DO jdir = idir, 3
            ijdir = ijdir+1
            DO ispin = 1, nspins
               CALL cp_fm_set_all(psi1_efg(ispin, ijdir)%matrix, 0.0_dp)
            ENDDO
            IF (output_unit > 0) THEN
               WRITE (output_unit, "(T10,A)") "Response to the perturbation operator efg_"//ACHAR(idir+119)//ACHAR(jdir+119)
            ENDIF
            !
            !Initial guess for psi1
            DO ispin = 1, nspins
               CALL cp_fm_set_all(psi1(ispin)%matrix, 0.0_dp)
               !CALL cp_fm_to_fm(p_psi0(ispin,ijdir)%matrix, psi1(ispin)%matrix)
               !CALL cp_fm_scale(-1.0_dp,psi1(ispin)%matrix)
            ENDDO
            !
            !DO scf cycle to optimize psi1
            DO ispin = 1, nspins
               CALL cp_fm_to_fm(efg_psi0(ispin, ijdir)%matrix, h1_psi0(ispin)%matrix)
            ENDDO
            !
            !
            linres_control%lr_triplet = .FALSE.
            linres_control%do_kernel = .FALSE.
            linres_control%converged = .FALSE.
            CALL linres_solver(p_env, qs_env, psi1, h1_psi0, psi0_order, should_stop)
            !
            !
            ! copy the response
            DO ispin = 1, nspins
               CALL cp_fm_to_fm(psi1(ispin)%matrix, psi1_efg(ispin, ijdir)%matrix)
               CALL cp_fm_frobenius_norm(psi1(ispin)%matrix, fro)
               chk = chk+fro
            ENDDO
            !
            ! print response functions
            !IF(BTEST(cp_print_key_should_output(logger%iter_info,issc_section,&
            !     &   "PRINT%RESPONSE_FUNCTION_CUBES"),cp_p_file)) THEN
            !   ncubes = SIZE(list_cubes,1)
            !   print_key => section_vals_get_subs_vals(issc_section,"PRINT%RESPONSE_FUNCTION_CUBES")
            !   DO ispin = 1,nspins
            !      CALL qs_print_cubes(qs_env,psi1(ispin)%matrix,ncubes,list_cubes,&
            !            centers_set(ispin)%array,print_key,'psi1_efg',&
            !            idir=ijdir,ispin=ispin)
            !   ENDDO ! ispin
            !ENDIF ! print response functions
            !
            !
            IF (output_unit > 0) THEN
               WRITE (output_unit, "(T10,A)") "Write the resulting psi1 in restart file... not implemented yet"
            ENDIF
            !
            ! Write the result in the restart file
         ENDDO ! jdir
         ENDDO ! idir
      ENDIF
      !
      ! operator pso
      IF (do_pso) THEN
         DO idir = 1, 3
            DO ispin = 1, nspins
               CALL cp_fm_set_all(psi1_pso(ispin, idir)%matrix, 0.0_dp)
            ENDDO
            IF (output_unit > 0) THEN
               WRITE (output_unit, "(T10,A)") "Response to the perturbation operator pso_"//ACHAR(idir+119)
            ENDIF
            !
            !Initial guess for psi1
            DO ispin = 1, nspins
               CALL cp_fm_set_all(psi1(ispin)%matrix, 0.0_dp)
               !CALL cp_fm_to_fm(rxp_psi0(ispin,idir)%matrix, psi1(ispin)%matrix)
               !CALL cp_fm_scale(-1.0_dp,psi1(ispin)%matrix)
            ENDDO
            !
            !DO scf cycle to optimize psi1
            DO ispin = 1, nspins
               CALL cp_fm_to_fm(pso_psi0(ispin, idir)%matrix, h1_psi0(ispin)%matrix)
            ENDDO
            !
            !
            linres_control%lr_triplet = .FALSE. ! we do singlet response
            linres_control%do_kernel = .FALSE. ! we do uncoupled response
            linres_control%converged = .FALSE.
            CALL linres_solver(p_env, qs_env, psi1, h1_psi0, psi0_order, should_stop)
            !
            !
            ! copy the response
            DO ispin = 1, nspins
               CALL cp_fm_to_fm(psi1(ispin)%matrix, psi1_pso(ispin, idir)%matrix)
               CALL cp_fm_frobenius_norm(psi1(ispin)%matrix, fro)
               chk = chk+fro
            ENDDO
            !
            ! print response functions
            !IF(BTEST(cp_print_key_should_output(logger%iter_info,issc_section,&
            !     &   "PRINT%RESPONSE_FUNCTION_CUBES"),cp_p_file)) THEN
            !   ncubes = SIZE(list_cubes,1)
            !   print_key => section_vals_get_subs_vals(issc_section,"PRINT%RESPONSE_FUNCTION_CUBES")
            !   DO ispin = 1,nspins
            !      CALL qs_print_cubes(qs_env,psi1(ispin)%matrix,ncubes,list_cubes,&
            !           centers_set(ispin)%array,print_key,'psi1_pso',&
            !           idir=idir,ispin=ispin)
            !   ENDDO ! ispin
            !ENDIF ! print response functions
            !
            !
            IF (output_unit > 0) THEN
               WRITE (output_unit, "(T10,A)") "Write the resulting psi1 in restart file... not implemented yet"
            ENDIF
            !
            ! Write the result in the restart file
         ENDDO ! idir
      ENDIF
      !
      ! operator fc
      IF (do_fc) THEN
         DO ispin = 1, nspins
            CALL cp_fm_set_all(psi1_fc(ispin)%matrix, 0.0_dp)
         ENDDO
         IF (output_unit > 0) THEN
            WRITE (output_unit, "(T10,A)") "Response to the perturbation operator fc"
         ENDIF
         !
         !Initial guess for psi1
         DO ispin = 1, nspins
            CALL cp_fm_set_all(psi1(ispin)%matrix, 0.0_dp)
            !CALL cp_fm_to_fm(rxp_psi0(ispin,idir)%matrix, psi1(ispin)%matrix)
            !CALL cp_fm_scale(-1.0_dp,psi1(ispin)%matrix)
         ENDDO
         !
         !DO scf cycle to optimize psi1
         DO ispin = 1, nspins
            CALL cp_fm_to_fm(fc_psi0(ispin)%matrix, h1_psi0(ispin)%matrix)
         ENDDO
         !
         !
         linres_control%lr_triplet = .TRUE. ! we do triplet response
         linres_control%do_kernel = .TRUE. ! we do coupled response
         linres_control%converged = .FALSE.
         CALL linres_solver(p_env, qs_env, psi1, h1_psi0, psi0_order, should_stop)
         !
         !
         ! copy the response
         DO ispin = 1, nspins
            CALL cp_fm_to_fm(psi1(ispin)%matrix, psi1_fc(ispin)%matrix)
            CALL cp_fm_frobenius_norm(psi1(ispin)%matrix, fro)
            chk = chk+fro
         ENDDO
         !
         ! print response functions
         !IF(BTEST(cp_print_key_should_output(logger%iter_info,issc_section,&
         !     &   "PRINT%RESPONSE_FUNCTION_CUBES"),cp_p_file)) THEN
         !   ncubes = SIZE(list_cubes,1)
         !   print_key => section_vals_get_subs_vals(issc_section,"PRINT%RESPONSE_FUNCTION_CUBES")
         !   DO ispin = 1,nspins
         !      CALL qs_print_cubes(qs_env,psi1(ispin)%matrix,ncubes,list_cubes,&
         !           centers_set(ispin)%array,print_key,'psi1_pso',&
         !           idir=idir,ispin=ispin)
         !   ENDDO ! ispin
         !ENDIF ! print response functions
         !
         !
         IF (output_unit > 0) THEN
            WRITE (output_unit, "(T10,A)") "Write the resulting psi1 in restart file... not implemented yet"
         ENDIF
         !
         ! Write the result in the restart file
      ENDIF

      !>>>> debugging only
      !
      ! here we have the operator r and compute the polarizability for debugging the kernel only
      IF (do_dso) THEN
         DO idir = 1, 3
            DO ispin = 1, nspins
               CALL cp_fm_set_all(psi1_dso(ispin, idir)%matrix, 0.0_dp)
            ENDDO
            IF (output_unit > 0) THEN
               WRITE (output_unit, "(T10,A)") "Response to the perturbation operator r_"//ACHAR(idir+119)
            ENDIF
            !
            !Initial guess for psi1
            DO ispin = 1, nspins
               CALL cp_fm_set_all(psi1(ispin)%matrix, 0.0_dp)
               !CALL cp_fm_to_fm(rxp_psi0(ispin,idir)%matrix, psi1(ispin)%matrix)
               !CALL cp_fm_scale(-1.0_dp,psi1(ispin)%matrix)
            ENDDO
            !
            !DO scf cycle to optimize psi1
            DO ispin = 1, nspins
               CALL cp_fm_to_fm(dso_psi0(ispin, idir)%matrix, h1_psi0(ispin)%matrix)
            ENDDO
            !
            !
            linres_control%lr_triplet = .FALSE. ! we do singlet response
            linres_control%do_kernel = .TRUE. ! we do uncoupled response
            linres_control%converged = .FALSE.
            CALL linres_solver(p_env, qs_env, psi1, h1_psi0, psi0_order, should_stop)
            !
            !
            ! copy the response
            DO ispin = 1, nspins
               CALL cp_fm_to_fm(psi1(ispin)%matrix, psi1_dso(ispin, idir)%matrix)
               CALL cp_fm_frobenius_norm(psi1(ispin)%matrix, fro)
               chk = chk+fro
            ENDDO
            !
            ! print response functions
            !IF(BTEST(cp_print_key_should_output(logger%iter_info,issc_section,&
            !     &   "PRINT%RESPONSE_FUNCTION_CUBES"),cp_p_file)) THEN
            !   ncubes = SIZE(list_cubes,1)
            !   print_key => section_vals_get_subs_vals(issc_section,"PRINT%RESPONSE_FUNCTION_CUBES")
            !   DO ispin = 1,nspins
            !      CALL qs_print_cubes(qs_env,psi1(ispin)%matrix,ncubes,list_cubes,&
            !           centers_set(ispin)%array,print_key,'psi1_pso',&
            !           idir=idir,ispin=ispin)
            !   ENDDO ! ispin
            !ENDIF ! print response functions
            !
            !
            IF (output_unit > 0) THEN
               WRITE (output_unit, "(T10,A)") "Write the resulting psi1 in restart file... not implemented yet"
            ENDIF
            !
            ! Write the result in the restart file
         ENDDO ! idir
      ENDIF
      !<<<< debugging only

      !
      !
      ! print the checksum
      IF (output_unit > 0) THEN
         WRITE (output_unit, '(T2,A,E23.16)') 'ISSC| response: CheckSum =', chk
      ENDIF
      !
      !
      ! clean up
      DO ispin = 1, nspins
         CALL cp_fm_release(psi1(ispin)%matrix)
         CALL cp_fm_release(h1_psi0(ispin)%matrix)
      ENDDO
      DEALLOCATE (psi1, h1_psi0, psi0_order)
      !
      CALL cp_print_key_finished_output(output_unit, logger, lr_section,&
           &                            "PRINT%PROGRAM_RUN_INFO")
      !
      CALL timestop(handle)
      !
   END SUBROUTINE issc_response

! **************************************************************************************************
!> \brief ...
!> \param issc_env ...
!> \param qs_env ...
!> \param iatom ...
! **************************************************************************************************
   SUBROUTINE issc_issc(issc_env, qs_env, iatom)

      TYPE(issc_env_type)                                :: issc_env
      TYPE(qs_environment_type), POINTER                 :: qs_env
      INTEGER, INTENT(IN)                                :: iatom

      CHARACTER(LEN=*), PARAMETER :: routineN = 'issc_issc', routineP = moduleN//':'//routineN

      INTEGER                                            :: handle, ispin, ixyz, jatom, jxyz, natom, &
                                                            nmo, nspins
      LOGICAL                                            :: do_dso, do_fc, do_pso, do_sd, gapw
      REAL(dp)                                           :: buf, facdso, facfc, facpso, facsd, g, &
                                                            issc_dso, issc_fc, issc_pso, issc_sd, &
                                                            maxocc
      REAL(dp), DIMENSION(3)                             :: r_i, r_j
      REAL(dp), DIMENSION(:, :, :, :, :), POINTER        :: issc
      TYPE(cell_type), POINTER                           :: cell
      TYPE(cp_fm_p_type), DIMENSION(:), POINTER          :: fc_psi0, psi1_fc
      TYPE(cp_fm_p_type), DIMENSION(:, :), POINTER       :: psi1_dso, psi1_efg, psi1_pso
      TYPE(cp_fm_type), POINTER                          :: mo_coeff
      TYPE(dbcsr_p_type), DIMENSION(:), POINTER          :: matrix_dso, matrix_efg, matrix_fc, &
                                                            matrix_pso
      TYPE(dft_control_type), POINTER                    :: dft_control
      TYPE(mo_set_p_type), DIMENSION(:), POINTER         :: mos
      TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      TYPE(section_vals_type), POINTER                   :: issc_section

      CALL timeset(routineN, handle)

      NULLIFY (cell, dft_control, particle_set, issc, psi1_fc, psi1_efg, psi1_pso)
      NULLIFY (matrix_efg, matrix_fc, matrix_pso, mos, mo_coeff, fc_psi0)

      CALL get_qs_env(qs_env=qs_env, &
                      cell=cell, &
                      dft_control=dft_control, &
                      particle_set=particle_set, &
                      mos=mos)

      gapw = dft_control%qs_control%gapw
      natom = SIZE(particle_set, 1)
      nspins = dft_control%nspins

      CALL get_issc_env(issc_env=issc_env, &
                        matrix_efg=matrix_efg, &
                        matrix_pso=matrix_pso, &
                        matrix_fc=matrix_fc, &
                        matrix_dso=matrix_dso, &
                        psi1_fc=psi1_fc, &
                        psi1_efg=psi1_efg, &
                        psi1_pso=psi1_pso, &
                        psi1_dso=psi1_dso, &
                        fc_psi0=fc_psi0, &
                        issc=issc, &
                        do_fc=do_fc, &
                        do_sd=do_sd, &
                        do_pso=do_pso, &
                        do_dso=do_dso)

      g = e_mass/(2.0_dp*p_mass)
      facfc = hertz*g**2*a_fine**4
      facpso = hertz*g**2*a_fine**4
      facsd = hertz*g**2*a_fine**4
      facdso = hertz*g**2*a_fine**4

      !
      !
      issc_section => section_vals_get_subs_vals(qs_env%input, &
           & "PROPERTIES%LINRES%SPINSPIN")
      !
      ! Initialize
      DO ispin = 1, nspins
         CALL get_mo_set(mo_set=mos(ispin)%mo_set, mo_coeff=mo_coeff, maxocc=maxocc)
         CALL cp_fm_get_info(mo_coeff, ncol_global=nmo)

         DO jatom = 1, natom
            r_i = particle_set(iatom)%r
            r_j = particle_set(jatom)%r
            r_j = pbc(r_i, r_j, cell)+r_i
            !
            !
            !
            !write(*,*) 'iatom =',iatom,' r_i=',r_i
            !write(*,*) 'jatom =',jatom,' r_j=',r_j
            !
            ! FC term
            !
            IF (do_fc .AND. iatom .NE. jatom) THEN
               !
               ! build the integral for the jatom
               CALL dbcsr_set(matrix_fc(1)%matrix, 0.0_dp)
               CALL build_fermi_contact_matrix(qs_env, matrix_fc, r_j)
               CALL cp_dbcsr_sm_fm_multiply(matrix_fc(1)%matrix, mo_coeff, &
                                      fc_psi0(ispin)%matrix, ncol=nmo,& ! fc_psi0 a buffer
                    &                 alpha=1.0_dp)

               CALL cp_fm_trace(fc_psi0(ispin)%matrix, mo_coeff, buf)
               WRITE (*, *) ' jatom', jatom, 'tr(P*fc)=', buf

               CALL cp_fm_trace(fc_psi0(ispin)%matrix, psi1_fc(ispin)%matrix, buf)
               issc_fc = 2.0_dp*2.0_dp*maxocc*facfc*buf
               issc(1, 1, iatom, jatom, 1) = issc(1, 1, iatom, jatom, 1)+issc_fc
               issc(2, 2, iatom, jatom, 1) = issc(2, 2, iatom, jatom, 1)+issc_fc
               issc(3, 3, iatom, jatom, 1) = issc(3, 3, iatom, jatom, 1)+issc_fc
            ENDIF
            !
            ! SD term
            !
            IF (do_sd .AND. iatom .NE. jatom) THEN
               !
               ! build the integral for the jatom
               CALL dbcsr_set(matrix_efg(1)%matrix, 0.0_dp)
               CALL dbcsr_set(matrix_efg(2)%matrix, 0.0_dp)
               CALL dbcsr_set(matrix_efg(3)%matrix, 0.0_dp)
               CALL dbcsr_set(matrix_efg(4)%matrix, 0.0_dp)
               CALL dbcsr_set(matrix_efg(5)%matrix, 0.0_dp)
               CALL dbcsr_set(matrix_efg(6)%matrix, 0.0_dp)
               CALL build_efg_matrix(qs_env, matrix_efg, r_j)
               DO ixyz = 1, 6
                  CALL cp_dbcsr_sm_fm_multiply(matrix_efg(ixyz)%matrix, mo_coeff, &
                                         fc_psi0(ispin)%matrix, ncol=nmo,& ! fc_psi0 a buffer
                       &                 alpha=1.0_dp, beta=0.0_dp)
                  CALL cp_fm_trace(fc_psi0(ispin)%matrix, mo_coeff, buf)
                  WRITE (*, *) ' jatom', jatom, ixyz, 'tr(P*efg)=', buf
                  DO jxyz = 1, 6
                     CALL cp_fm_trace(fc_psi0(ispin)%matrix, psi1_efg(ispin, jxyz)%matrix, buf)
                     issc_sd = 2.0_dp*maxocc*facsd*buf
                     !issc(ixyz,jxyz,iatom,jatom) = issc_sd
                     !write(*,*) 'pso_',ixyz,jxyz,' iatom',iatom,'jatom',jatom,issc_pso
                  ENDDO
               ENDDO
            ENDIF
            !
            ! PSO term
            !
            IF (do_pso .AND. iatom .NE. jatom) THEN
               !
               ! build the integral for the jatom
               CALL dbcsr_set(matrix_pso(1)%matrix, 0.0_dp)
               CALL dbcsr_set(matrix_pso(2)%matrix, 0.0_dp)
               CALL dbcsr_set(matrix_pso(3)%matrix, 0.0_dp)
               CALL build_pso_matrix(qs_env, matrix_pso, r_j)
               DO ixyz = 1, 3
                  CALL cp_dbcsr_sm_fm_multiply(matrix_pso(ixyz)%matrix, mo_coeff, &
                                         fc_psi0(ispin)%matrix, ncol=nmo,& ! fc_psi0 a buffer
                       &                 alpha=1.0_dp, beta=0.0_dp)
                  DO jxyz = 1, 3
                     CALL cp_fm_trace(fc_psi0(ispin)%matrix, psi1_pso(ispin, jxyz)%matrix, buf)
                     issc_pso = -2.0_dp*maxocc*facpso*buf
                     issc(ixyz, jxyz, iatom, jatom, 3) = issc(ixyz, jxyz, iatom, jatom, 3)+issc_pso
                  ENDDO
               ENDDO
            ENDIF
            !
            ! DSO term
            !
            !>>>>> for debugging we compute here the polarizability and NOT the DSO term!
            IF (do_dso .AND. iatom .EQ. natom .AND. jatom .EQ. natom) THEN
               !
               ! build the integral for the jatom
               !CALL dbcsr_set(matrix_dso(1)%matrix,0.0_dp)
               !CALL dbcsr_set(matrix_dso(2)%matrix,0.0_dp)
               !CALL dbcsr_set(matrix_dso(3)%matrix,0.0_dp)
               !CALL dbcsr_set(matrix_dso(4)%matrix,0.0_dp)
               !CALL dbcsr_set(matrix_dso(5)%matrix,0.0_dp)
               !CALL dbcsr_set(matrix_dso(6)%matrix,0.0_dp)
               !CALL build_dso_matrix(qs_env,matrix_dso,r_i,r_j)
               !DO ixyz = 1,6
               !   CALL cp_sm_fm_multiply(matrix_dso(ixyz)%matrix,mo_coeff,&
               !        &                 fc_psi0(ispin)%matrix,ncol=nmo,& ! fc_psi0 a buffer
               !        &                 alpha=1.0_dp,beta=0.0_dp)
               !   CALL cp_fm_trace(fc_psi0(ispin)%matrix,mo_coeff,buf)
               !   issc_dso = 2.0_dp * maxocc * facdso * buf
               !   issc(ixyz,jxyz,iatom,jatom,4) = issc_dso
               !ENDDO
               !CALL dbcsr_set(matrix_dso(1)%matrix,0.0_dp)
               !CALL dbcsr_set(matrix_dso(2)%matrix,0.0_dp)
               !CALL dbcsr_set(matrix_dso(3)%matrix,0.0_dp)
               !CALL rRc_xyz_ao(matrix_dso,qs_env,(/0.0_dp,0.0_dp,0.0_dp/),1)
               DO ixyz = 1, 3
                  CALL cp_dbcsr_sm_fm_multiply(matrix_dso(ixyz)%matrix, mo_coeff, &
                                         fc_psi0(ispin)%matrix, ncol=nmo,& ! fc_psi0 a buffer
                       &                 alpha=1.0_dp, beta=0.0_dp)
                  DO jxyz = 1, 3
                     CALL cp_fm_trace(psi1_dso(ispin, jxyz)%matrix, fc_psi0(ispin)%matrix, buf)
                     ! we save the polarizability for a checksum later on !
                     issc_dso = 2.0_dp*maxocc*buf
                     !WRITE(*,*) ixyz,jxyz,'tr(P_r*r)=',2.0_dp * maxocc * buf
                     issc(ixyz, jxyz, iatom, jatom, 4) = issc(ixyz, jxyz, iatom, jatom, 4)+issc_dso
                  ENDDO
               ENDDO

            ENDIF
            !
         ENDDO ! jatom
      ENDDO ! ispin
      !
      !
      ! Finalize
      CALL timestop(handle)
      !
   END SUBROUTINE issc_issc

! **************************************************************************************************
!> \brief ...
!> \param issc_env ...
!> \param qs_env ...
! **************************************************************************************************
   SUBROUTINE issc_print(issc_env, qs_env)
      TYPE(issc_env_type)                                :: issc_env
      TYPE(qs_environment_type), POINTER                 :: qs_env

      CHARACTER(len=*), PARAMETER :: routineN = 'issc_print', routineP = moduleN//':'//routineN

      CHARACTER(LEN=2)                                   :: element_symbol_i, element_symbol_j
      CHARACTER(LEN=default_string_length)               :: name_i, name_j, title
      INTEGER                                            :: iatom, jatom, natom, output_unit, &
                                                            unit_atoms
      LOGICAL                                            :: do_dso, do_fc, do_pso, do_sd, gapw
      REAL(dp)                                           :: eig(3), issc_iso_dso, issc_iso_fc, &
                                                            issc_iso_pso, issc_iso_sd, &
                                                            issc_iso_tot, issc_tmp(3, 3)
      REAL(dp), DIMENSION(:, :, :, :, :), POINTER        :: issc
      REAL(dp), EXTERNAL                                 :: DDOT
      TYPE(atomic_kind_type), POINTER                    :: atom_kind_i, atom_kind_j
      TYPE(cp_logger_type), POINTER                      :: logger
      TYPE(dft_control_type), POINTER                    :: dft_control
      TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      TYPE(section_vals_type), POINTER                   :: issc_section

      NULLIFY (logger, particle_set, atom_kind_i, atom_kind_j, dft_control)

      logger => cp_get_default_logger()
      output_unit = cp_logger_get_default_io_unit(logger)

      issc_section => section_vals_get_subs_vals(qs_env%input, &
                                                 "PROPERTIES%LINRES%SPINSPIN")

      CALL get_issc_env(issc_env=issc_env, &
                        issc=issc, &
                        do_fc=do_fc, &
                        do_sd=do_sd, &
                        do_pso=do_pso, &
                        do_dso=do_dso)
      !
      CALL get_qs_env(qs_env=qs_env, &
                      dft_control=dft_control, &
                      particle_set=particle_set)

      natom = SIZE(particle_set, 1)
      gapw = dft_control%qs_control%gapw

      !
      IF (output_unit > 0) THEN
         WRITE (output_unit, '(T2,A,E14.6)') 'ISSC| CheckSum K =', &
            SQRT(DDOT(SIZE(issc), issc, 1, issc, 1))
      ENDIF
      !
      IF (BTEST(cp_print_key_should_output(logger%iter_info, issc_section, &
                                           "PRINT%K_MATRIX"), cp_p_file)) THEN

         unit_atoms = cp_print_key_unit_nr(logger, issc_section, "PRINT%K_MATRIX", &
                                           extension=".data", middle_name="K", log_filename=.FALSE.)

         IF (unit_atoms > 0) THEN
            WRITE (unit_atoms, *)
            WRITE (unit_atoms, *)
            WRITE (title, '(A)') "Indirect spin-spin coupling matrix"
            WRITE (unit_atoms, '(T2,A)') title
            DO iatom = 1, natom
               atom_kind_i => particle_set(iatom)%atomic_kind
               CALL get_atomic_kind(atom_kind_i, name=name_i, element_symbol=element_symbol_i)
               DO jatom = 1, natom
                  atom_kind_j => particle_set(jatom)%atomic_kind
                  CALL get_atomic_kind(atom_kind_j, name=name_j, element_symbol=element_symbol_j)
                  !
                  IF (iatom .EQ. jatom .AND. .NOT. do_dso) CYCLE
                  !
                  !
                  ! FC
                  issc_tmp(:, :) = issc(:, :, iatom, jatom, 1)
                  issc_tmp(:, :) = 0.5_dp*(issc_tmp(:, :)+TRANSPOSE(issc_tmp(:, :)))
                  CALL diamat_all(issc_tmp, eig)
                  issc_iso_fc = (eig(1)+eig(2)+eig(3))/3.0_dp
                  !
                  ! SD
                  issc_tmp(:, :) = issc(:, :, iatom, jatom, 2)
                  issc_tmp(:, :) = 0.5_dp*(issc_tmp(:, :)+TRANSPOSE(issc_tmp(:, :)))
                  CALL diamat_all(issc_tmp, eig)
                  issc_iso_sd = (eig(1)+eig(2)+eig(3))/3.0_dp
                  !
                  ! PSO
                  issc_tmp(:, :) = issc(:, :, iatom, jatom, 3)
                  issc_tmp(:, :) = 0.5_dp*(issc_tmp(:, :)+TRANSPOSE(issc_tmp(:, :)))
                  CALL diamat_all(issc_tmp, eig)
                  issc_iso_pso = (eig(1)+eig(2)+eig(3))/3.0_dp
                  !
                  ! DSO
                  issc_tmp(:, :) = issc(:, :, iatom, jatom, 4)
                  issc_tmp(:, :) = 0.5_dp*(issc_tmp(:, :)+TRANSPOSE(issc_tmp(:, :)))
                  CALL diamat_all(issc_tmp, eig)
                  issc_iso_dso = (eig(1)+eig(2)+eig(3))/3.0_dp
                  !
                  ! TOT
                  issc_iso_tot = issc_iso_fc+issc_iso_sd+issc_iso_dso+issc_iso_pso
                  !
                  !
                  WRITE (unit_atoms, *)
                  WRITE (unit_atoms, '(T2,2(A,I5,A,2X,A2))') 'Indirect spin-spin coupling between ', &
                     iatom, TRIM(name_i), element_symbol_i, ' and ', &
                     jatom, TRIM(name_j), element_symbol_j
                  !
                  IF (do_fc) WRITE (unit_atoms, '(T1,A,f12.4,A)') ' Isotropic FC contribution  = ', issc_iso_fc, ' Hz'
                  IF (do_sd) WRITE (unit_atoms, '(T1,A,f12.4,A)') ' Isotropic SD contribution  = ', issc_iso_sd, ' Hz'
                  IF (do_pso) WRITE (unit_atoms, '(T1,A,f12.4,A)') ' Isotropic PSO contribution = ', issc_iso_pso, ' Hz'
                  !IF(do_dso) WRITE(unit_atoms,'(T1,A,f12.4,A)') ' Isotropic DSO contribution = ',issc_iso_dso,' Hz'
                  IF (do_dso) WRITE (unit_atoms, '(T1,A,f12.4,A)') ' !!! POLARIZABILITY (for the moment) = ', issc_iso_dso, ' Hz'
                  IF (.NOT. do_dso) WRITE (unit_atoms, '(T1,A,f12.4,A)') ' Isotropic coupling         = ', issc_iso_tot, ' Hz'
               ENDDO
            ENDDO
         ENDIF
         CALL cp_print_key_finished_output(unit_atoms, logger, issc_section,&
              &                            "PRINT%K_MATRIX")
      ENDIF
      !
      !
   END SUBROUTINE issc_print

! **************************************************************************************************
!> \brief Initialize the issc environment
!> \param issc_env ...
!> \param qs_env ...
! **************************************************************************************************
   SUBROUTINE issc_env_init(issc_env, qs_env)
      !
      TYPE(issc_env_type)                                :: issc_env
      TYPE(qs_environment_type), POINTER                 :: qs_env

      CHARACTER(LEN=*), PARAMETER :: routineN = 'issc_env_init', routineP = moduleN//':'//routineN

      INTEGER                                            :: handle, iatom, idir, ini, ir, ispin, &
                                                            istat, m, n, n_rep, nao, natom, &
                                                            nspins, output_unit
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: first_sgf, last_sgf
      INTEGER, DIMENSION(:), POINTER                     :: list, row_blk_sizes
      LOGICAL                                            :: gapw
      TYPE(cp_fm_struct_type), POINTER                   :: tmp_fm_struct
      TYPE(cp_fm_type), POINTER                          :: mo_coeff
      TYPE(cp_logger_type), POINTER                      :: logger
      TYPE(dbcsr_distribution_type), POINTER             :: dbcsr_dist
      TYPE(dft_control_type), POINTER                    :: dft_control
      TYPE(linres_control_type), POINTER                 :: linres_control
      TYPE(mo_set_p_type), DIMENSION(:), POINTER         :: mos
      TYPE(neighbor_list_set_p_type), DIMENSION(:), &
         POINTER                                         :: sab_orb
      TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
      TYPE(section_vals_type), POINTER                   :: issc_section, lr_section

!

      CALL timeset(routineN, handle)

      NULLIFY (linres_control)
      NULLIFY (logger, issc_section)
      NULLIFY (tmp_fm_struct)
      NULLIFY (particle_set, qs_kind_set)
      NULLIFY (sab_orb)

      logger => cp_get_default_logger()
      lr_section => section_vals_get_subs_vals(qs_env%input, "PROPERTIES%LINRES")

      output_unit = cp_print_key_unit_nr(logger, lr_section, "PRINT%PROGRAM_RUN_INFO", &
                                         extension=".linresLog")

      IF (issc_env%ref_count /= 0) THEN
         CALL issc_env_cleanup(issc_env)
      ENDIF

      IF (output_unit > 0) THEN
         WRITE (output_unit, "(/,T20,A,/)") "*** Start indirect spin-spin coupling Calculation ***"
         WRITE (output_unit, "(T10,A,/)") "Inizialization of the ISSC environment"
      ENDIF

      CALL issc_env_create(issc_env)
      !
      issc_section => section_vals_get_subs_vals(qs_env%input, &
           &          "PROPERTIES%LINRES%SPINSPIN")
      !CALL section_vals_val_get(nmr_section,"INTERPOLATE_SHIFT",l_val=nmr_env%interpolate_shift)
      !CALL section_vals_val_get(nmr_section,"SHIFT_GAPW_RADIUS",r_val=nmr_env%shift_gapw_radius)

      CALL get_qs_env(qs_env=qs_env, &
                      dft_control=dft_control, &
                      linres_control=linres_control, &
                      mos=mos, &
                      sab_orb=sab_orb, &
                      particle_set=particle_set, &
                      qs_kind_set=qs_kind_set, &
                      dbcsr_dist=dbcsr_dist)
      !
      !
      gapw = dft_control%qs_control%gapw
      nspins = dft_control%nspins
      natom = SIZE(particle_set, 1)
      !
      ! check that the psi0 are localized and you have all the centers
      IF (.NOT. linres_control%localized_psi0) &
         CALL cp_warn(__LOCATION__, 'To get indirect spin-spin coupling parameters within '// &
                      'PBC you need to localize zero order orbitals')
      !
      !
      ! read terms need to be calculated
      ! FC
      CALL section_vals_val_get(issc_section, "DO_FC", l_val=issc_env%do_fc)
      ! SD
      CALL section_vals_val_get(issc_section, "DO_SD", l_val=issc_env%do_sd)
      ! PSO
      CALL section_vals_val_get(issc_section, "DO_PSO", l_val=issc_env%do_pso)
      ! DSO
      CALL section_vals_val_get(issc_section, "DO_DSO", l_val=issc_env%do_dso)
      !
      !
      ! read the list of atoms on which the issc need to be calculated
      CALL section_vals_val_get(issc_section, "ISSC_ON_ATOM_LIST", n_rep_val=n_rep)
      !
      !
      NULLIFY (issc_env%issc_on_atom_list)
      n = 0
      DO ir = 1, n_rep
         NULLIFY (list)
         CALL section_vals_val_get(issc_section, "ISSC_ON_ATOM_LIST", i_rep_val=ir, i_vals=list)
         IF (ASSOCIATED(list)) THEN
            CALL reallocate(issc_env%issc_on_atom_list, 1, n+SIZE(list))
            DO ini = 1, SIZE(list)
               issc_env%issc_on_atom_list(ini+n) = list(ini)
            ENDDO
            n = n+SIZE(list)
         ENDIF
      ENDDO
      !
      IF (.NOT. ASSOCIATED(issc_env%issc_on_atom_list)) THEN
         ALLOCATE (issc_env%issc_on_atom_list(natom), STAT=istat)
         CPASSERT(istat .EQ. 0)
         DO iatom = 1, natom
            issc_env%issc_on_atom_list(iatom) = iatom
         ENDDO
      ENDIF
      issc_env%issc_natms = SIZE(issc_env%issc_on_atom_list)
      !
      !
      ! Initialize the issc tensor
      ALLOCATE (issc_env%issc(3, 3, issc_env%issc_natms, issc_env%issc_natms, 4), &
                issc_env%issc_loc(3, 3, issc_env%issc_natms, issc_env%issc_natms, 4), &
                STAT=istat)
      CPASSERT(istat == 0)
      issc_env%issc(:, :, :, :, :) = 0.0_dp
      issc_env%issc_loc(:, :, :, :, :) = 0.0_dp
      !
      ! allocation
      ALLOCATE (issc_env%efg_psi0(nspins, 6), issc_env%pso_psi0(nspins, 3), issc_env%fc_psi0(nspins), &
                issc_env%psi1_efg(nspins, 6), issc_env%psi1_pso(nspins, 3), issc_env%psi1_fc(nspins), &
                issc_env%dso_psi0(nspins, 3), issc_env%psi1_dso(nspins, 3), &
                STAT=istat)
      CPASSERT(istat == 0)
      DO ispin = 1, nspins
         !mo_coeff => current_env%psi0_order(ispin)%matrix
         CALL get_mo_set(mo_set=mos(ispin)%mo_set, mo_coeff=mo_coeff)
         CALL cp_fm_get_info(mo_coeff, ncol_global=m, nrow_global=nao)

         NULLIFY (tmp_fm_struct)
         CALL cp_fm_struct_create(tmp_fm_struct, nrow_global=nao, &
                                  ncol_global=m, &
                                  context=mo_coeff%matrix_struct%context)
         DO idir = 1, 6
            NULLIFY (issc_env%psi1_efg(ispin, idir)%matrix, issc_env%efg_psi0(ispin, idir)%matrix)
            CALL cp_fm_create(issc_env%psi1_efg(ispin, idir)%matrix, tmp_fm_struct)
            CALL cp_fm_create(issc_env%efg_psi0(ispin, idir)%matrix, tmp_fm_struct)
         ENDDO
         DO idir = 1, 3
            NULLIFY (issc_env%psi1_pso(ispin, idir)%matrix, issc_env%pso_psi0(ispin, idir)%matrix, &
                     issc_env%dso_psi0(ispin, idir)%matrix)
            CALL cp_fm_create(issc_env%psi1_pso(ispin, idir)%matrix, tmp_fm_struct)
            CALL cp_fm_create(issc_env%pso_psi0(ispin, idir)%matrix, tmp_fm_struct)
            CALL cp_fm_create(issc_env%psi1_dso(ispin, idir)%matrix, tmp_fm_struct)
            CALL cp_fm_create(issc_env%dso_psi0(ispin, idir)%matrix, tmp_fm_struct)
         ENDDO
         NULLIFY (issc_env%psi1_fc(ispin)%matrix, issc_env%fc_psi0(ispin)%matrix)
         CALL cp_fm_create(issc_env%psi1_fc(ispin)%matrix, tmp_fm_struct)
         CALL cp_fm_create(issc_env%fc_psi0(ispin)%matrix, tmp_fm_struct)
         CALL cp_fm_struct_release(tmp_fm_struct)
      ENDDO
      !
      ! prepare for allocation
      ALLOCATE (first_sgf(natom))
      ALLOCATE (last_sgf(natom))
      CALL get_particle_set(particle_set, qs_kind_set, &
                            first_sgf=first_sgf, &
                            last_sgf=last_sgf)
      ALLOCATE (row_blk_sizes(natom))
      CALL convert_offsets_to_sizes(first_sgf, row_blk_sizes, last_sgf)
      DEALLOCATE (first_sgf)
      DEALLOCATE (last_sgf)

      !
      ! efg, pso and fc operators
      CALL dbcsr_allocate_matrix_set(issc_env%matrix_efg, 6)
      ALLOCATE (issc_env%matrix_efg(1)%matrix)
      CALL dbcsr_create(matrix=issc_env%matrix_efg(1)%matrix, &
                        name="efg (3xx-rr)/3", &
                        dist=dbcsr_dist, matrix_type=dbcsr_type_symmetric, &
                        row_blk_size=row_blk_sizes, col_blk_size=row_blk_sizes, &
                        nze=0, mutable_work=.TRUE.)
      CALL cp_dbcsr_alloc_block_from_nbl(issc_env%matrix_efg(1)%matrix, sab_orb)

      ALLOCATE (issc_env%matrix_efg(2)%matrix, &
                issc_env%matrix_efg(3)%matrix, issc_env%matrix_efg(4)%matrix, &
                issc_env%matrix_efg(5)%matrix, issc_env%matrix_efg(6)%matrix)
      CALL dbcsr_copy(issc_env%matrix_efg(2)%matrix, issc_env%matrix_efg(1)%matrix, &
                      'efg xy')
      CALL dbcsr_copy(issc_env%matrix_efg(3)%matrix, issc_env%matrix_efg(1)%matrix, &
                      'efg xz')
      CALL dbcsr_copy(issc_env%matrix_efg(4)%matrix, issc_env%matrix_efg(1)%matrix, &
                      'efg (3yy-rr)/3')
      CALL dbcsr_copy(issc_env%matrix_efg(5)%matrix, issc_env%matrix_efg(1)%matrix, &
                      'efg yz')
      CALL dbcsr_copy(issc_env%matrix_efg(6)%matrix, issc_env%matrix_efg(1)%matrix, &
                      'efg (3zz-rr)/3')

      CALL dbcsr_set(issc_env%matrix_efg(1)%matrix, 0.0_dp)
      CALL dbcsr_set(issc_env%matrix_efg(2)%matrix, 0.0_dp)
      CALL dbcsr_set(issc_env%matrix_efg(3)%matrix, 0.0_dp)
      CALL dbcsr_set(issc_env%matrix_efg(4)%matrix, 0.0_dp)
      CALL dbcsr_set(issc_env%matrix_efg(5)%matrix, 0.0_dp)
      CALL dbcsr_set(issc_env%matrix_efg(6)%matrix, 0.0_dp)
      !
      ! PSO
      CALL dbcsr_allocate_matrix_set(issc_env%matrix_pso, 3)
      ALLOCATE (issc_env%matrix_pso(1)%matrix)
      CALL dbcsr_create(matrix=issc_env%matrix_pso(1)%matrix, &
                        name="pso x", &
                        dist=dbcsr_dist, matrix_type=dbcsr_type_antisymmetric, &
                        row_blk_size=row_blk_sizes, col_blk_size=row_blk_sizes, &
                        nze=0, mutable_work=.TRUE.)
      CALL cp_dbcsr_alloc_block_from_nbl(issc_env%matrix_pso(1)%matrix, sab_orb)

      ALLOCATE (issc_env%matrix_pso(2)%matrix, issc_env%matrix_pso(3)%matrix)
      CALL dbcsr_copy(issc_env%matrix_pso(2)%matrix, issc_env%matrix_pso(1)%matrix, &
                      'pso y')
      CALL dbcsr_copy(issc_env%matrix_pso(3)%matrix, issc_env%matrix_pso(1)%matrix, &
                      'pso z')
      CALL dbcsr_set(issc_env%matrix_pso(1)%matrix, 0.0_dp)
      CALL dbcsr_set(issc_env%matrix_pso(2)%matrix, 0.0_dp)
      CALL dbcsr_set(issc_env%matrix_pso(3)%matrix, 0.0_dp)
      !
      ! DSO
      CALL dbcsr_allocate_matrix_set(issc_env%matrix_dso, 3)
      ALLOCATE (issc_env%matrix_dso(1)%matrix, issc_env%matrix_dso(2)%matrix, issc_env%matrix_dso(3)%matrix)
      CALL dbcsr_copy(issc_env%matrix_dso(1)%matrix, issc_env%matrix_efg(1)%matrix, &
                      'dso x')
      CALL dbcsr_copy(issc_env%matrix_dso(2)%matrix, issc_env%matrix_efg(1)%matrix, &
                      'dso y')
      CALL dbcsr_copy(issc_env%matrix_dso(3)%matrix, issc_env%matrix_efg(1)%matrix, &
                      'dso z')
      CALL dbcsr_set(issc_env%matrix_dso(1)%matrix, 0.0_dp)
      CALL dbcsr_set(issc_env%matrix_dso(2)%matrix, 0.0_dp)
      CALL dbcsr_set(issc_env%matrix_dso(3)%matrix, 0.0_dp)
      !
      ! FC
      CALL dbcsr_allocate_matrix_set(issc_env%matrix_fc, 1)
      ALLOCATE (issc_env%matrix_fc(1)%matrix)
      CALL dbcsr_copy(issc_env%matrix_fc(1)%matrix, issc_env%matrix_efg(1)%matrix, &
                      'fc')
      CALL dbcsr_set(issc_env%matrix_fc(1)%matrix, 0.0_dp)

      DEALLOCATE (row_blk_sizes)
      !
      ! Conversion factors
      IF (output_unit > 0) THEN
         WRITE (output_unit, "(T2,A,T60,I4,A)")&
              & "ISSC| spin-spin coupling computed for ", issc_env%issc_natms, ' atoms'
      ENDIF

      CALL cp_print_key_finished_output(output_unit, logger, lr_section,&
           &                            "PRINT%PROGRAM_RUN_INFO")

      CALL timestop(handle)

   END SUBROUTINE issc_env_init

! **************************************************************************************************
!> \brief Deallocate the issc environment
!> \param issc_env ...
!> \par History
! **************************************************************************************************
   SUBROUTINE issc_env_cleanup(issc_env)

      TYPE(issc_env_type)                                :: issc_env

      CHARACTER(LEN=*), PARAMETER :: routineN = 'issc_env_cleanup', &
         routineP = moduleN//':'//routineN

      INTEGER                                            :: idir, ispin

      issc_env%ref_count = issc_env%ref_count-1
      IF (issc_env%ref_count == 0) THEN
         IF (ASSOCIATED(issc_env%issc_on_atom_list)) THEN
            DEALLOCATE (issc_env%issc_on_atom_list)
         ENDIF
         IF (ASSOCIATED(issc_env%issc)) THEN
            DEALLOCATE (issc_env%issc)
         ENDIF
         IF (ASSOCIATED(issc_env%issc_loc)) THEN
            DEALLOCATE (issc_env%issc_loc)
         ENDIF
         !
         !efg_psi0
         IF (ASSOCIATED(issc_env%efg_psi0)) THEN
            DO idir = 1, SIZE(issc_env%efg_psi0, 2)
               DO ispin = 1, SIZE(issc_env%efg_psi0, 1)
                  CALL cp_fm_release(issc_env%efg_psi0(ispin, idir)%matrix)
               ENDDO
            ENDDO
            DEALLOCATE (issc_env%efg_psi0)
         ENDIF
         !
         !pso_psi0
         IF (ASSOCIATED(issc_env%pso_psi0)) THEN
            DO idir = 1, SIZE(issc_env%pso_psi0, 2)
               DO ispin = 1, SIZE(issc_env%pso_psi0, 1)
                  CALL cp_fm_release(issc_env%pso_psi0(ispin, idir)%matrix)
               ENDDO
            ENDDO
            DEALLOCATE (issc_env%pso_psi0)
         ENDIF
         !
         !dso_psi0
         IF (ASSOCIATED(issc_env%dso_psi0)) THEN
            DO idir = 1, SIZE(issc_env%dso_psi0, 2)
               DO ispin = 1, SIZE(issc_env%dso_psi0, 1)
                  CALL cp_fm_release(issc_env%dso_psi0(ispin, idir)%matrix)
               ENDDO
            ENDDO
            DEALLOCATE (issc_env%dso_psi0)
         ENDIF
         !
         !fc_psi0
         IF (ASSOCIATED(issc_env%fc_psi0)) THEN
            DO ispin = 1, SIZE(issc_env%fc_psi0, 1)
               CALL cp_fm_release(issc_env%fc_psi0(ispin)%matrix)
            ENDDO
            DEALLOCATE (issc_env%fc_psi0)
         ENDIF
         !
         !psi1_efg
         IF (ASSOCIATED(issc_env%psi1_efg)) THEN
            DO idir = 1, SIZE(issc_env%psi1_efg, 2)
               DO ispin = 1, SIZE(issc_env%psi1_efg, 1)
                  CALL cp_fm_release(issc_env%psi1_efg(ispin, idir)%matrix)
               ENDDO
            ENDDO
            DEALLOCATE (issc_env%psi1_efg)
         ENDIF
         !
         !psi1_pso
         IF (ASSOCIATED(issc_env%psi1_pso)) THEN
            DO idir = 1, SIZE(issc_env%psi1_pso, 2)
               DO ispin = 1, SIZE(issc_env%psi1_pso, 1)
                  CALL cp_fm_release(issc_env%psi1_pso(ispin, idir)%matrix)
               ENDDO
            ENDDO
            DEALLOCATE (issc_env%psi1_pso)
         ENDIF
         !
         !psi1_dso
         IF (ASSOCIATED(issc_env%psi1_dso)) THEN
            DO idir = 1, SIZE(issc_env%psi1_dso, 2)
               DO ispin = 1, SIZE(issc_env%psi1_dso, 1)
                  CALL cp_fm_release(issc_env%psi1_dso(ispin, idir)%matrix)
               ENDDO
            ENDDO
            DEALLOCATE (issc_env%psi1_dso)
         ENDIF
         !
         !psi1_fc
         IF (ASSOCIATED(issc_env%psi1_fc)) THEN
            DO ispin = 1, SIZE(issc_env%psi1_fc, 1)
               CALL cp_fm_release(issc_env%psi1_fc(ispin)%matrix)
            ENDDO
            DEALLOCATE (issc_env%psi1_fc)
         ENDIF
         !
         ! cubes
         !IF(ASSOCIATED(issc_env%list_cubes)) THEN
         !   DEALLOCATE(issc_env%list_cubes,STAT=istat)
         !   CPPostcondition(istat==0,cp_failure_level,routineP,failure)
         !ENDIF
         !
         !matrix_efg
         IF (ASSOCIATED(issc_env%matrix_efg)) THEN
            CALL dbcsr_deallocate_matrix_set(issc_env%matrix_efg)
         ENDIF
         !
         !matrix_pso
         IF (ASSOCIATED(issc_env%matrix_pso)) THEN
            CALL dbcsr_deallocate_matrix_set(issc_env%matrix_pso)
         ENDIF
         !
         !matrix_dso
         IF (ASSOCIATED(issc_env%matrix_dso)) THEN
            CALL dbcsr_deallocate_matrix_set(issc_env%matrix_dso)
         ENDIF
         !
         !matrix_fc
         IF (ASSOCIATED(issc_env%matrix_fc)) THEN
            CALL dbcsr_deallocate_matrix_set(issc_env%matrix_fc)
         ENDIF

      ENDIF ! ref count

   END SUBROUTINE issc_env_cleanup

END MODULE qs_linres_issc_utils
