kerker.F90 3.82 KB
Newer Older
1
!--------------------------------------------------------------------------------
Daniel Wortmann's avatar
Daniel Wortmann committed
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
Daniel Wortmann's avatar
Daniel Wortmann committed
9

10
  SUBROUTINE kerker( field,  fmpi, &
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
    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
38

39
    TYPE(t_mpi),       INTENT(in)    :: fmpi
40
    TYPE(t_atoms),     INTENT(in)    :: atoms
41 42 43 44
    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
    CALL resDen%init( stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN )
    CALL vYukawa%init( stars, atoms, sphhar, vacuum, noco, input%jspins, 4 )
52
    MPI0_b: IF( fmpi%irank == 0 ) THEN
53 54 55
       CALL resDen%subPotDen( outDen, inDen )
       IF( input%jspins == 2 ) CALL resDen%SpinsToChargeAndMagnetisation()
    END IF MPI0_b
Daniel Wortmann's avatar
Daniel Wortmann committed
56
#ifdef CPP_MPI
57
    CALL mpi_bc_potden( fmpi, stars, sphhar, atoms, input, vacuum, oneD, noco, resDen )
Daniel Wortmann's avatar
Daniel Wortmann committed
58
#endif
59
    IF ( .NOT. input%film ) THEN
60
       CALL vgen_coulomb( 1, fmpi,  oneD, input, field, vacuum, sym, stars, cell, &
61
            sphhar, atoms, .FALSE., resDen, vYukawa )
62
    ELSE
63
       call resDenMod%init( stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN )
64
       if( fmpi%irank == 0 ) then
65 66
          call resDenMod%copyPotDen( resDen )
       end if
67
#ifdef CPP_MPI
68
       CALL mpi_bc_potden( fmpi, stars, sphhar, atoms, input, vacuum, oneD, noco, resDenMod )
69
#endif
70
       vYukawa%iter = resDen%iter
71
       CALL VYukawaFilm( stars, vacuum, cell, sym, input, fmpi, atoms, sphhar, oneD, noco, resDenMod, &
72 73 74
            vYukawa )
    END IF

75
    MPI0_c: IF( fmpi%irank == 0 ) THEN
76 77 78 79 80 81 82 83
       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
84 85
       resDen%vacz  = resDen%vacz  - input%preconditioning_param ** 2 / fpi_const * vYukawa%vacz
       resDen%vacxy = resDen%vacxy - input%preconditioning_param ** 2 / fpi_const * vYukawa%vacxy
86 87 88
       IF( input%jspins == 2 ) CALL resDen%ChargeAndMagnetisationToSpins()
       ! fix the preconditioned density
       CALL outDen%addPotDen( resDen, inDen )
89
       CALL qfix(fmpi,stars, atoms, sym, vacuum, sphhar, input, cell, oneD, outDen, noco%l_noco, .FALSE., l_par=.FALSE., force_fix=.TRUE., fix=fix )
Daniel Wortmann's avatar
Daniel Wortmann committed
90
       CALL resDen%subPotDen( outDen, inDen )
91
    END IF MPI0_c
92
    CALL precon_v%from_density(resden)
93 94 95

  END SUBROUTINE kerker

96
END MODULE m_kerker