Line data    Source code

       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : MODULE m_hsmt_fjgj
       7             :   USE m_juDFT
       8             :   IMPLICIT NONE
       9             : 
      10             :   PRIVATE
      11             :   TYPE t_fjgj
      12             :     REAL,ALLOCATABLE    :: fj(:,:,:,:),gj(:,:,:,:)
      13             :   CONTAINS
      14             :     procedure :: alloc
      15             :     procedure :: calculate => hsmt_fjgj_cpu
      16             :   END TYPE
      17             :   PUBLIC t_fjgj
      18             : 
      19             : CONTAINS
      20       16551 :   subroutine alloc(fjgj,nvd,lmaxd,isp,noco)
      21             :     USE m_types
      22             :     CLASS(t_fjgj),INTENT(OUT) :: fjgj
      23             :     INTEGER,INTENT(IN)        :: nvd,lmaxd,isp
      24             :     TYPE(t_noco),INTENT(IN)   :: noco
      25             : 
      26      115755 :     ALLOCATE(fjgj%fj(nvd,0:lmaxd,merge(1,isp,noco%l_noco):merge(2,isp,noco%l_noco),MERGE(2,1,noco%l_ss)))
      27       82755 :     ALLOCATE(fjgj%gj(nvd,0:lmaxd,merge(1,isp,noco%l_noco):merge(2,isp,noco%l_noco),MERGE(2,1,noco%l_ss)))
      28             : 
      29    24724302 :     fjgj%fj = 0.0
      30    24724302 :     fjgj%gj = 0.0
      31             : 
      32       16551 :   end subroutine
      33             : 
      34       35991 :   SUBROUTINE hsmt_fjgj_cpu(fjgj,input,atoms,cell,lapw,noco,usdus,n,ispin)
      35             :     !Calculate the fj&gj array which contain the part of the A,B matching coeff. depending on the
      36             :     !radial functions at the MT boundary as contained in usdus
      37             :     USE m_constants, ONLY : fpi_const
      38             :     USE m_sphbes
      39             :     USE m_dsphbs
      40             :     USE m_types
      41             :     IMPLICIT NONE
      42             :     CLASS(t_fjgj),INTENT(INOUT) :: fjgj
      43             :     TYPE(t_input),INTENT(IN)    :: input
      44             :     TYPE(t_cell),INTENT(IN)     :: cell
      45             :     TYPE(t_noco),INTENT(IN)     :: noco
      46             :     TYPE(t_atoms),INTENT(IN)    :: atoms
      47             :     TYPE(t_lapw),INTENT(IN)     :: lapw
      48             :     TYPE(t_usdus),INTENT(IN)    :: usdus
      49             :     !     ..
      50             :     !     .. Scalar Arguments ..
      51             :     INTEGER, INTENT (IN) :: ispin,n
      52             : 
      53             :     !     ..
      54             :     !     .. Local Scalars ..
      55             :     REAL con1,ff,gg,gs
      56             : 
      57             :     INTEGER k,l,lo,intspin,jspin, jspinStart, jSpinEnd
      58             :     LOGICAL l_socfirst
      59             :     !     .. Local Arrays ..
      60       35991 :     REAL ws(input%jspins)
      61       35991 :     REAL gb(0:atoms%lmaxd), fb(0:atoms%lmaxd)
      62       35991 :     LOGICAL apw(0:atoms%lmaxd)
      63             :     !     ..
      64       35991 :     l_socfirst = noco%l_soc .AND. noco%l_noco .AND. (.NOT. noco%l_ss)
      65       35991 :     con1 = fpi_const/SQRT(cell%omtil)
      66      362900 :     DO l = 0,atoms%lmax(n)
      67      680352 :        apw(l)=ANY(atoms%l_dulo(:atoms%nlo(n),n))
      68      362900 :        IF ((input%l_useapw).AND.(atoms%lapw_l(n).GE.l)) apw(l) = .FALSE.
      69             :     ENDDO
      70       73040 :     DO lo = 1,atoms%nlo(n)
      71       73040 :        IF (atoms%l_dulo(lo,n)) apw(atoms%llo(lo,n)) = .TRUE.
      72             :     ENDDO
      73             : 
      74       35991 :     jspinStart = ispin
      75       35991 :     jspinEnd = ispin
      76      337444 :     IF (any(noco%l_constrained).or.l_socfirst.OR.any(noco%l_unrestrictMT).OR.any(noco%l_spinoffd_ldau)) THEN
      77        2320 :        jspinStart = 1
      78        2320 :        jspinEnd = input%jspins
      79             :     END IF
      80             : 
      81      107973 :     DO intspin=1,MERGE(2,1,noco%l_ss)
      82             : #ifndef _OPENACC
      83             :        !$OMP PARALLEL DO DEFAULT(NONE) &
      84             :        !$OMP PRIVATE(l,gs,fb,gb,ws,ff,gg,jspin)&
      85             :        !$OMP SHARED(lapw,atoms,con1,usdus,l_socfirst,noco,input)&
      86       72118 :        !$OMP SHARED(fjgj,intspin,n,ispin,apw,jspinStart,jspinEnd)
      87             : #else
      88             :        !!$acc parallel loop present(fjgj,fjgj%fj,fjgj%gj) private(l,gs,fb,gb,ws,ff,gg,jspin)
      89             : #endif
      90             :        DO k = 1,lapw%nv(intspin)
      91             :           gs = lapw%rk(k,intspin)*atoms%rmt(n)
      92             :           CALL sphbes(atoms%lmax(n),gs, fb)
      93             :           CALL dsphbs(atoms%lmax(n),gs,fb, gb)
      94             : !          !$OMP SIMD PRIVATE(ws,ff,gg)
      95             :           !!$acc parallel loop vector PRIVATE(ws,ff,gg) present(fjgj,fjgj%fj,fjgj%gj)
      96             :           DO l = 0,atoms%lmax(n)
      97             :              !---> set up wronskians for the matching conditions for each ntype
      98             :              DO jspin = jspinStart, jspinEnd
      99             :                 ws(jspin) = con1/(usdus%uds(l,n,jspin)*usdus%dus(l,n,jspin)&
     100             :                             - usdus%us(l,n,jspin)*usdus%duds(l,n,jspin))
     101             :              END DO
     102             :              ff = fb(l)
     103             :              gg = lapw%rk(k,intspin)*gb(l)
     104             :              DO jspin = jspinStart, jspinEnd
     105             :                 IF ( apw(l) ) THEN
     106             :                    fjgj%fj(k,l,jspin,intspin) = 1.0*con1 * ff / usdus%us(l,n,jspin)
     107             :                    fjgj%gj(k,l,jspin,intspin) = 0.0
     108             :                 ELSE
     109             :                    fjgj%fj(k,l,jspin,intspin) = ws(jspin) * ( usdus%uds(l,n,jspin)*gg - usdus%duds(l,n,jspin)*ff )
     110             :                    fjgj%gj(k,l,jspin,intspin) = ws(jspin) * ( usdus%dus(l,n,jspin)*ff - usdus%us(l,n,jspin)*gg )
     111             :                 ENDIF
     112             :              END DO
     113             :           ENDDO
     114             :           !!$acc end parallel loop
     115             : !          !$OMP END SIMD
     116             :        ENDDO ! k = 1, lapw%nv
     117             : #ifdef _OPENACC
     118             :        !!$acc end parallel loop
     119             : #else
     120             :        !$OMP END PARALLEL DO
     121             : #endif
     122             :     ENDDO
     123       35991 :     RETURN
     124             :   END SUBROUTINE hsmt_fjgj_cpu
     125       33102 : END MODULE m_hsmt_fjgj