kerker.F90 3.74 KB
Newer Older
1
!--------------------------------------------------------------------------------
2 3 4 5 6
! 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
7

8
CONTAINS
9

10
  SUBROUTINE kerker( field, DIMENSION, mpi, &
11 12
       stars, atoms, sphhar, vacuum, input, sym, cell, noco, &
       oneD, inDen, outDen, precon_v  )
13

14
    !Implementation of the Kerker preconditioner by M.Hinzen
15

16 17 18 19 20 21 22
    USE m_vgen_coulomb
    USE m_VYukawaFilm
    USE m_juDFT
    USE m_qfix
    USE m_types
    USE m_types_mixvector
    USE m_constants
23

24
#ifdef CPP_MPI    
25
    USE m_mpi_bc_potden
26
#endif    
27
    IMPLICIT NONE
28

29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44
    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
    TYPE(t_field),     INTENT(inout) :: field
    TYPE(t_dimension), INTENT(in)    :: DIMENSION
    TYPE(t_mpi),       INTENT(in)    :: mpi
    TYPE(t_atoms),     INTENT(in)    :: atoms 
    TYPE(t_potden),    INTENT(inout) :: outDen
    TYPE(t_potden),    INTENT(in)    :: inDen
    TYPE(t_mixvector), INTENT(INOUT) :: precon_v

45 46 47
    type(t_potden)                   :: resDen, vYukawa, resDenMod
    real                             :: fix
    integer                          :: lh,n
48

49

50 51 52 53 54 55
    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
56
#ifdef CPP_MPI
57
    CALL mpi_bc_potden( mpi, stars, sphhar, atoms, input, vacuum, oneD, noco, resDen )
58
#endif
59 60 61 62
    IF ( .NOT. input%film ) THEN
       CALL vgen_coulomb( 1, mpi, DIMENSION, oneD, input, field, vacuum, sym, stars, cell, &
            sphhar, atoms, resDen, vYukawa )
    ELSE
63 64 65 66
       if( mpi%irank == 0 ) then 
          call resDenMod%init( stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN )
          call resDenMod%copyPotDen( resDen )
       end if
67
       vYukawa%iter = resDen%iter
68
       CALL VYukawaFilm( stars, vacuum, cell, sym, input, mpi, atoms, sphhar, oneD, noco, resDenMod, &
69 70 71 72 73 74 75 76 77 78 79 80
            vYukawa )
    END IF

    MPI0_c: IF( mpi%irank == 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
81 82
       resDen%vacz  = resDen%vacz  - input%preconditioning_param ** 2 / fpi_const * vYukawa%vacz
       resDen%vacxy = resDen%vacxy - input%preconditioning_param ** 2 / fpi_const * vYukawa%vacxy
83 84 85 86
       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 )
Daniel Wortmann's avatar
Daniel Wortmann committed
87
       CALL resDen%subPotDen( outDen, inDen )
88
    END IF MPI0_c
89
    CALL precon_v%from_density(resden)
90 91 92

  END SUBROUTINE kerker

93
END MODULE m_kerker