type_mixvector.F90 6.59 KB
Newer Older
Daniel Wortmann's avatar
Daniel Wortmann committed
1 2 3 4
!--------------------------------------------------------------------------------
! 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.
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
!--------------------------------------------------------------------------------
MODULE m_types_mixvector
  use m_types
  implicit none
  PRIVATE
  !Here we store the pointers used for metric
  TYPE(t_oneD),POINTER   :: oneD
  TYPE(t_input),POINTER  :: input
  TYPE(t_vacuum),POINTER :: vacuum
  TYPE(t_noco),POINTER   :: noco
  TYPE(t_sym),POINTER    :: sym
  TYPE(t_stars),POINTER  :: stars
  TYPE(t_cell),POINTER   :: cell
  TYPE(t_sphhar),POINTER :: sphhar
  TYPE(t_atoms),POINTER  :: atoms  =>null()  
  INTEGER                :: mmap, mmaph, nmaph, nmap, mapmt, mapvac, mapvac2
  real                   :: intfac,vacfac
  
  TYPE,PUBLIC:: t_mixvector
     REAL,ALLOCATABLE       :: vec(:)
     LOGICAL                :: l_pot=.false. !Is this a potential?
Daniel Wortmann's avatar
Daniel Wortmann committed
26
   CONTAINS
27 28 29 30 31
     PROCEDURE :: init=>mixvector_init
     procedure :: alloc=>mixvector_alloc
     PROCEDURE :: from_density=>mixvector_from_density
     PROCEDURE :: to_density=>mixvector_to_density
     PROCEDURE :: apply_metric=>mixvector_metric
Daniel Wortmann's avatar
Daniel Wortmann committed
32 33
  END TYPE t_mixvector

34
  INTERFACE assignment(=)
Daniel Wortmann's avatar
Daniel Wortmann committed
35
     MODULE PROCEDURE assign_vectors
36
  END INTERFACE assignment(=)
Daniel Wortmann's avatar
Daniel Wortmann committed
37 38 39 40 41 42 43 44 45 46 47 48 49

  INTERFACE OPERATOR (*)
     MODULE PROCEDURE multiply_scalar
  END INTERFACE OPERATOR (*)
  INTERFACE OPERATOR (+)
     MODULE PROCEDURE add_vectors
  END INTERFACE OPERATOR (+)
  INTERFACE OPERATOR (-)
     MODULE PROCEDURE subtract_vectors
  END INTERFACE OPERATOR (-)
  INTERFACE OPERATOR (.dot.)
     MODULE PROCEDURE multiply_dot
  END INTERFACE OPERATOR (.dot.)
50 51 52 53 54

  public :: Operator(+),operator(-),operator(*),operator(.dot.)
  public :: assignment(=)
  
  
Daniel Wortmann's avatar
Daniel Wortmann committed
55 56 57 58 59 60 61 62 63
CONTAINS

  SUBROUTINE mixvector_from_density(vec,den)
    USE m_types
    USE m_brysh1
    IMPLICIT NONE
    CLASS(t_mixvector),INTENT(INOUT)    :: vec
    TYPE(t_potden),    INTENT(in)       :: Den

64 65
    CALL brysh1( input, stars, atoms, sphhar, noco, vacuum, sym, oneD, &
         intfac, vacfac, Den, nmap, nmaph, mapmt, mapvac, mapvac2, vec%vec)
Daniel Wortmann's avatar
Daniel Wortmann committed
66 67 68 69 70 71 72 73 74
  END SUBROUTINE mixvector_from_density

  SUBROUTINE mixvector_to_density(vec,den)
    USE m_types
    USE m_brysh2
    IMPLICIT NONE
    CLASS(t_mixvector),INTENT(IN)    :: vec
    TYPE(t_potden),    INTENT(OUT)       :: Den

75
    CALL brysh2( input, stars, atoms, sphhar, noco, vacuum, sym, vec%vec,oneD,den)
Daniel Wortmann's avatar
Daniel Wortmann committed
76 77 78 79 80 81 82 83 84 85 86
  END SUBROUTINE mixvector_to_density


  FUNCTION mixvector_metric(vec)RESULT(mvec)
    USE m_types
    USE m_metric
    IMPLICIT NONE
    CLASS(t_mixvector),INTENT(IN)    :: vec
    TYPE(t_mixvector)                :: mvec

    mvec=vec
87 88
    CALL metric( cell, atoms, vacuum, sphhar, input, noco, stars, sym, oneD, &
         mmap, nmaph, mapmt, mapvac2, vec%vec, mvec%vec, vec%l_pot )
Daniel Wortmann's avatar
Daniel Wortmann committed
89
  END FUNCTION mixvector_metric
90 91

  SUBROUTINE mixvector_init(vec,oneD_i,input_i,vacuum_i,noco_i,sym_i,stars_i,cell_i,sphhar_i,atoms_i)
Daniel Wortmann's avatar
Daniel Wortmann committed
92 93 94
    USE m_types
    IMPLICIT NONE
    CLASS(t_mixvector),INTENT(OUT)    :: vec
95 96 97 98 99 100 101 102 103 104 105
    TYPE(t_oneD),INTENT(IN),TARGET   :: oneD_i
    TYPE(t_input),INTENT(IN),TARGET  :: input_i
    TYPE(t_vacuum),INTENT(IN),TARGET :: vacuum_i
    TYPE(t_noco),INTENT(IN),TARGET   :: noco_i
    TYPE(t_sym),INTENT(IN),TARGET    :: sym_i
    TYPE(t_stars),INTENT(IN),TARGET  :: stars_i
    TYPE(t_cell),INTENT(IN),TARGET   :: cell_i
    TYPE(t_sphhar),INTENT(IN),TARGET :: sphhar_i
    TYPE(t_atoms),INTENT(IN),TARGET  :: atoms_i

    if(.not.associated(atoms)) then
Daniel Wortmann's avatar
Daniel Wortmann committed
106
    !Store pointers to data-types
107 108 109
    oneD=>oneD_i;input=>input_i;vacuum=>vacuum_i;noco=>noco_i
    sym=>sym_i;stars=>stars_i;cell=>cell_i;sphhar=>sphhar_i;atoms=>atoms_i

Daniel Wortmann's avatar
Daniel Wortmann committed
110 111 112
    !In systems without inversions symmetry the interstitial star-
    !coefficients are complex. Thus twice as many numbers have to be
    !stored.
113 114
    intfac=MERGE(1,2,sym%invs)

Daniel Wortmann's avatar
Daniel Wortmann committed
115 116
    !The corresponding is true for the coeff. of the warping vacuum
    !density depending on the two dimensional inversion.
117 118 119
    vacfac=MERGE(1,2,sym%invs2)

    mmaph = intfac * stars%ng3 + atoms%ntype * ( sphhar%nlhd + 1 ) * atoms%jmtd + &
Daniel Wortmann's avatar
Daniel Wortmann committed
120
         vacfac * vacuum%nmzxyd * ( oneD%odi%n2d - 1 ) * vacuum%nvac + vacuum%nmzd * vacuum%nvac
121
    mmap  =mmaph * input%jspins
Daniel Wortmann's avatar
Daniel Wortmann committed
122 123 124 125
    !in a non-collinear calculations extra space is needed for the
    !off-diag. part of the density matrix. these coeff. are generally
    !complex independ of invs and invs2.
    IF ( noco%l_noco ) THEN
126
       mmap = mmap + 2 * stars%ng3 + 2 * vacuum%nmzxyd * ( oneD%odi%n2d - 1 ) * vacuum%nvac + &
Daniel Wortmann's avatar
Daniel Wortmann committed
127
            2 * vacuum%nmzd * vacuum%nvac
128
       IF (noco%l_mtnocopot) mmap= mmap+ 2*atoms%ntype * ( sphhar%nlhd + 1 ) * atoms%jmtd 
Daniel Wortmann's avatar
Daniel Wortmann committed
129
    END IF
130

Daniel Wortmann's avatar
Daniel Wortmann committed
131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146
    ! LDA+U (start)
    PRINT *,"MIXING of LDA+U missing....."
    !n_mmpTemp = inDen%mmpMat
    !n_u_keep = atoms%n_u
    !IF ( atoms%n_u > 0 ) CALL u_mix( input, atoms, inDen%mmpMat, outDen%mmpMat )
    !IF ( ANY( inDen%mmpMat(:,:,:,:) /= 0.0 ) ) THEN
    !    !In an LDA+U caclulation, also the density matrix is included in the
    !    !supervectors (sm,fsm) if no linear mixing is performed on it.
    !    IF ( input%ldauLinMix ) THEN
    !       atoms%n_u = 0
    !    ELSE
    !       mmap = mmap + 7 * 7 * 2 * atoms%n_u * input%jspins ! add 7*7 complex numbers per atoms%n_u and spin
    !    END IF
    ! ELSE
    !    atoms%n_u = 0
    ! END IF
147 148 149 150 151
 endif
 call vec%alloc()
 SUBROUTINE mixvector_alloc(vec)
    IMPLICIT NONE
    CLASS(t_mixvector),INTENT(OUT)    :: vec
Daniel Wortmann's avatar
Daniel Wortmann committed
152
    ALLOCATE( vec%vec(mmap) )
153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193
  END SUBROUTINE mixvector_alloc

  !The operators
  SUBROUTINE assign_vectors(vec,vecin)
    TYPE(t_mixvector),INTENT(OUT)::vec
    TYPE(t_mixvector),INTENT(IN) ::vecin
    vec=vecin
  END SUBROUTINE assign_vectors

  FUNCTION multiply_scalar(scalar,vec)RESULT(vecout)
    TYPE(t_mixvector),INTENT(IN)::vec
    REAL,INTENT(IN)             ::scalar
    TYPE(t_mixvector)           ::vecout

    vecout=vec
    vecout%vec=vecout%vec*scalar
  END FUNCTION multiply_scalar

  FUNCTION add_vectors(vec1,vec2)RESULT(vecout)
    TYPE(t_mixvector),INTENT(IN)::vec1,vec2
    TYPE(t_mixvector)           ::vecout

    vecout=vec1
    vecout%vec=vec1%vec+vec2%vec
  END FUNCTION add_vectors

  FUNCTION multiply_dot(vec1,vec2)RESULT(dprod)
    TYPE(t_mixvector),INTENT(IN)::vec1,vec2
    REAL                        ::dprod

    dprod=dot_PRODUCT(vec1%vec,vec2%vec)
  END FUNCTION multiply_dot

  FUNCTION subtract_vectors(vec1,vec2)RESULT(vecout)
    TYPE(t_mixvector),INTENT(IN)::vec1,vec2
    TYPE(t_mixvector)           ::vecout

    vecout=vec1
    vecout%vec=vec1%vec-vec2%vec
  END FUNCTION subtract_vectors
end MODULE m_types_mixvector