hsmt_fjgj.F90 3.41 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_hsmt_fjgj
Daniel Wortmann's avatar
Daniel Wortmann committed
7 8
  USE m_juDFT
  IMPLICIT NONE
9
CONTAINS
Daniel Wortmann's avatar
Daniel Wortmann committed
10 11 12
  SUBROUTINE hsmt_fjgj(input,atoms,cell,lapw,noco,usdus,n,ispin,fj,gj)
    !Calculate the fj&gj array which contain the part of the A,B matching coeff. depending on the
    !radial functions at the MT boundary as contained in usdus
13 14 15 16 17
    USE m_constants, ONLY : fpi_const
    USE m_sphbes
    USE m_dsphbs
    USE m_types
    IMPLICIT NONE
18
    TYPE(t_input),INTENT(IN)    :: input
19
    TYPE(t_cell),INTENT(IN)     :: cell
Daniel Wortmann's avatar
Daniel Wortmann committed
20
    TYPE(t_noco),INTENT(IN)     :: noco
21
    TYPE(t_atoms),INTENT(IN)    :: atoms
Daniel Wortmann's avatar
Daniel Wortmann committed
22
    TYPE(t_lapw),INTENT(IN)     :: lapw
23 24 25
    TYPE(t_usdus),INTENT(IN)    :: usdus
    !     ..
    !     .. Scalar Arguments ..
Daniel Wortmann's avatar
Daniel Wortmann committed
26 27
    INTEGER, INTENT (IN) :: ispin,n
  
28
    REAL,INTENT(OUT)     :: fj(:,0:,:,:),gj(:,0:,:,:)
29 30 31 32
    !     ..
    !     .. Local Scalars ..
    REAL con1,ff,gg,gs,ws

33 34
    INTEGER k,l,lo,intspin,jspin
    LOGICAL l_socfirst
35 36 37 38
    !     .. Local Arrays ..
    REAL gb(0:atoms%lmaxd), fb(0:atoms%lmaxd)
    LOGICAL apw(0:atoms%lmaxd)
    !     ..
39
    l_socfirst = noco%l_soc .AND. noco%l_noco .AND. (.NOT. noco%l_ss)
Daniel Wortmann's avatar
Daniel Wortmann committed
40 41 42 43 44 45 46 47 48 49 50
    con1 = fpi_const/SQRT(cell%omtil)
    DO l = 0,atoms%lmax(n)
       apw(l)=ANY(atoms%l_dulo(:atoms%nlo(n),n))
       IF ((input%l_useapw).AND.(atoms%lapw_l(n).GE.l)) apw(l) = .FALSE.
    ENDDO
    DO lo = 1,atoms%nlo(n)
       IF (atoms%l_dulo(lo,n)) apw(atoms%llo(lo,n)) = .TRUE.
    ENDDO
    DO intspin=1,MERGE(2,1,noco%l_noco)
       !$OMP PARALLEL DO DEFAULT(NONE) &
       !$OMP PRIVATE(l,gs,fb,gb,ws,ff,gg)&
51
       !$OMP SHARED(lapw,atoms,con1,usdus,l_socfirst,noco,input)&
Daniel Wortmann's avatar
Daniel Wortmann committed
52 53 54 55 56
       !$OMP SHARED(fj,gj,intspin,n,ispin,apw)
       DO k = 1,lapw%nv(intspin)
          gs = lapw%rk(k,intspin)*atoms%rmt(n)
          CALL sphbes(atoms%lmax(n),gs, fb)
          CALL dsphbs(atoms%lmax(n),gs,fb, gb)
57
!          !$OMP SIMD PRIVATE(ws,ff,gg)
58
          DO l = 0,atoms%lmax(n)
Daniel Wortmann's avatar
Daniel Wortmann committed
59 60 61 62 63 64
             !---> set up wronskians for the matching conditions for each ntype
             ws = con1/(usdus%uds(l,n,ispin)*usdus%dus(l,n,ispin)&
                  - usdus%us(l,n,ispin)*usdus%duds(l,n,ispin))
             ff = fb(l)
             gg = lapw%rk(k,intspin)*gb(l)
             IF ( apw(l) ) THEN
65 66
                fj(k,l,ispin,intspin) = 1.0*con1 * ff / usdus%us(l,n,ispin)
                gj(k,l,ispin,intspin) = 0.0d0
Daniel Wortmann's avatar
Daniel Wortmann committed
67
             ELSE
68 69 70 71 72 73 74 75 76
                IF (noco%l_constr.or.l_socfirst) THEN
                   DO jspin = 1, input%jspins
                      fj(k,l,jspin,intspin) = ws * ( usdus%uds(l,n,jspin)*gg - usdus%duds(l,n,jspin)*ff )
                      gj(k,l,jspin,intspin) = ws * ( usdus%dus(l,n,jspin)*ff - usdus%us(l,n,jspin)*gg )
                   END DO
                ELSE
                   fj(k,l,ispin,intspin) = ws * ( usdus%uds(l,n,ispin)*gg - usdus%duds(l,n,ispin)*ff )
                   gj(k,l,ispin,intspin) = ws * ( usdus%dus(l,n,ispin)*ff - usdus%us(l,n,ispin)*gg )
                ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
77
             ENDIF
78
          ENDDO
79
!          !$OMP END SIMD
Daniel Wortmann's avatar
Daniel Wortmann committed
80 81 82
       ENDDO ! k = 1, lapw%nv
       !$OMP END PARALLEL DO
    ENDDO
83 84 85
    RETURN
  END SUBROUTINE hsmt_fjgj
END MODULE m_hsmt_fjgj