kerker.F90 3.79 KB
Newer Older
1
!--------------------------------------------------------------------------------
Daniel Wortmann's avatar
Daniel Wortmann committed
2 3 4 5 6 7 8 9 10
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_kerker
  contains

    SUBROUTINE kerker(field, DIMENSION, mpi, &
                stars, atoms, sphhar, vacuum, input, sym, cell, noco, &
11
                oneD, inDen, outDen, precon_v  )
Daniel Wortmann's avatar
Daniel Wortmann committed
12 13 14 15
      !Implementation of the Kerker preconditioner by M.Hinzen
      USE m_vgen_coulomb
      USE m_VYukawaFilm
      USE m_juDFT
Daniel Wortmann's avatar
Daniel Wortmann committed
16
      USE m_qfix
Daniel Wortmann's avatar
Daniel Wortmann committed
17
      USE m_types
18 19
      USE m_types_mixvector
      USE m_constants
Daniel Wortmann's avatar
Daniel Wortmann committed
20 21 22 23 24 25 26 27 28
      IMPLICIT NONE
      TYPE(t_oneD),      INTENT(in)    :: oneD
      TYPE(t_input),     INTENT(in)    :: input
      TYPE(t_vacuum),    INTENT(in)    :: vacuum
      TYPE(t_noco),      INTENT(in)    :: noco
      TYPE(t_sym),       INTENT(in)    :: sym
      TYPE(t_stars),     INTENT(in)    :: stars
      TYPE(t_cell),      INTENT(in)    :: cell
      TYPE(t_sphhar),    INTENT(in)    :: sphhar
29
      TYPE(t_field),     INTENT(inout) :: field
Daniel Wortmann's avatar
Daniel Wortmann committed
30 31 32
      TYPE(t_dimension), INTENT(in)    :: DIMENSION
      TYPE(t_mpi),       INTENT(in)    :: mpi
      TYPE(t_atoms),     INTENT(in)    :: atoms 
33 34 35 36
      TYPE(t_potden),    INTENT(inout) :: outDen
      TYPE(t_potden),    INTENT(in)    :: inDen
      TYPE(t_mixvector), INTENT(INOUT) :: precon_v
     
Daniel Wortmann's avatar
Daniel Wortmann committed
37 38
      !Locals
      type(t_potden)                :: resDen, vYukawa
39 40
      real                          :: fix
      integer                       :: lh,n
Daniel Wortmann's avatar
Daniel Wortmann committed
41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
      
      CALL resDen%init( stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN )
      CALL vYukawa%init( stars, atoms, sphhar, vacuum, noco, input%jspins, 4 )
      MPI0_b: IF( mpi%irank == 0 ) THEN 
         CALL resDen%subPotDen( outDen, inDen )
         IF( input%jspins == 2 ) CALL resDen%SpinsToChargeAndMagnetisation()
      END IF MPI0_b
#ifdef CPP_MPI
      CALL mpi_bc_potden( mpi, stars, sphhar, atoms, input, vacuum, oneD, noco, resDen )
#endif
      IF ( .NOT. input%film ) THEN
         CALL vgen_coulomb( 1, mpi, DIMENSION, oneD, input, field, vacuum, sym, stars, cell, &
              sphhar, atoms, resDen, vYukawa )
      ELSE
         vYukawa%iter = resDen%iter
         CALL VYukawaFilm( stars, vacuum, cell, sym, input, mpi, atoms, sphhar, DIMENSION, oneD, resDen, &
              vYukawa )
      END IF
      
      MPI0_c: IF( mpi%irank == 0 ) THEN
         IF( input%preconditioning_param /= 0 ) THEN
            resDen%pw(1:stars%ng3,1) = resDen%pw(1:stars%ng3,1) - input%preconditioning_param ** 2 / fpi_const * vYukawa%pw(1:stars%ng3,1)
            DO n = 1, atoms%ntype
               DO lh = 0, sphhar%nlhd
                  resDen%mt(1:atoms%jri(n),lh,n,1) = resDen%mt(1:atoms%jri(n),lh,n,1) &
                       - input%preconditioning_param ** 2 / fpi_const &
                       * vYukawa%mt(1:atoms%jri(n),lh,n,1) * atoms%rmsh(1:atoms%jri(n),n) ** 2
               END DO
            END DO
            resDen%vacz  = resDen%vacz  - input%preconditioning_param ** 2 / fpi_const * vYukawa%vacz
            resDen%vacxy = resDen%vacxy - input%preconditioning_param ** 2 / fpi_const * vYukawa%vacxy
            IF( input%jspins == 2 ) CALL resDen%ChargeAndMagnetisationToSpins()
            ! fix the preconditioned density
            CALL outDen%addPotDen( resDen, inDen )
            CALL qfix(mpi,stars, atoms, sym, vacuum, sphhar, input, cell, oneD, outDen, noco%l_noco, .FALSE., .TRUE., fix )
            CALL resDen%subPotDen( outDen, inDen )
77
            call precon_v%from_density(resden)
Daniel Wortmann's avatar
Daniel Wortmann committed
78 79 80 81
         END IF
         ! end of preconditioner
      END IF MPI0_c
    END SUBROUTINE kerker
82
  end MODULE m_kerker