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 :
7 : MODULE m_abclocdn
8 : USE m_juDFT
9 : !*********************************************************************
10 : ! Calculates the (upper case) A, B and C coefficients for the local
11 : ! orbitals. The difference to abccoflo is, that a summation over the
12 : ! Gs ist performed. The A, B and C coeff. are set up for each eigen-
13 : ! state.
14 : ! Philipp Kurz 99/04
15 : !*********************************************************************
16 : !*************** ABBREVIATIONS ***************************************
17 : ! nkvec : stores the number of G-vectors that have been found and
18 : ! accepted during the construction of the local orbitals.
19 : ! kvec : k-vector used in hssphn to attach the local orbital 'lo'
20 : ! of atom 'na' to it.
21 : !*********************************************************************
22 : CONTAINS
23 46170 : SUBROUTINE abclocdn(atoms,noco,lapw,cell,ccchi,iintsp,phase,ylm,&
24 46170 : ntyp,na,k,nkvec,lo,ne,alo1,blo1,clo1,acof,bcof,ccof,zMat,l_force,fgp,force,na_index)
25 :
26 : USE m_types
27 : USE m_constants
28 :
29 : IMPLICIT NONE
30 :
31 : TYPE(t_noco), INTENT(IN) :: noco
32 : TYPE(t_atoms), INTENT(IN) :: atoms
33 : TYPE(t_lapw), INTENT(IN) :: lapw
34 : TYPE(t_cell), INTENT(IN) :: cell
35 : TYPE(t_mat), INTENT(IN) :: zMat
36 : TYPE(t_force), OPTIONAL, INTENT(INOUT) :: force
37 :
38 : ! .. Scalar Arguments ..
39 : INTEGER, INTENT (IN) :: iintsp
40 : INTEGER, INTENT (IN) :: k,na,ne,ntyp,nkvec,lo
41 : COMPLEX, INTENT (IN) :: phase
42 : LOGICAL, INTENT (IN) :: l_force
43 : INTEGER,INTENT(IN),OPTIONAL :: na_index
44 :
45 : ! .. Array Arguments ..
46 : REAL, INTENT (IN) :: alo1(:),blo1(:),clo1(:)
47 : COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 )
48 : COMPLEX, INTENT (IN) :: ccchi(2)
49 : COMPLEX, INTENT (INOUT) :: acof(:,0:,:)!(nobd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
50 : COMPLEX, INTENT (INOUT) :: bcof(:,0:,:)!(nobd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
51 : COMPLEX, INTENT (INOUT) :: ccof(-atoms%llod:,:,:,:)!(-atoms%llod:atoms%llod,nobd,atoms%nlod,atoms%nat)
52 : REAL, OPTIONAL, INTENT (IN) :: fgp(3)
53 :
54 : ! .. Local Scalars ..
55 46170 : COMPLEX ctmp,term1,work(ne)
56 : INTEGER i,j,l,ll1,lm,nbasf,m,na2,lmp,na_l
57 : ! ..
58 : ! ..
59 46170 : na_l=na
60 46170 : if (present(na_index)) na_l=na_index
61 46170 : term1 = 2 * tpi_const/SQRT(cell%omtil) * ((atoms%rmt(ntyp)**2)/2) * phase
62 : !---> the whole program is in hartree units, therefore 1/wronskian is
63 : !---> (rmt**2)/2. the factor i**l, which usually appears in the a, b
64 : !---> and c coefficients, is included in the t-matrices. thus, it does
65 : !---> not show up in the formula above.
66 46170 : l = atoms%llo(lo,ntyp)
67 46170 : ll1 = l* (l+1)
68 46170 : nbasf=lapw%nv(iintsp)+lapw%index_lo(lo,na)+nkvec
69 46170 : if (noco%l_noco) Then
70 4148 : if (noco%l_ss) THEN
71 0 : work = ccchi(iintsp)*zMat%data_c((iintsp-1)*(lapw%nv(1)+atoms%nlotot)+nbasf,:ne)
72 : else
73 80756 : work= ccchi(1)*zMat%data_c(nbasf,:ne)+ccchi(2)*zMat%data_c(lapw%nv(1)+atoms%nlotot+nbasf,:ne)
74 : ENDIF
75 : ELSE
76 42022 : if (zmat%l_real) Then
77 258198 : work=zmat%data_r(nbasf,:ne)
78 : else
79 568093 : work=zmat%data_c(nbasf,:ne)
80 : endif
81 : endif
82 :
83 : !!$acc kernels default(none) present(acof,bcof,ccof,alo1,blo1,clo1,ccchi,ylm)create(ctmp) &
84 : !!$acc copyin(work,na,term1,l,ne,ll1,noco)
85 : !!$acc loop seq private(i,m,lm,ctmp,na2,lmp)
86 907047 : DO i = 1,ne
87 : !!$acc loop seq
88 3241232 : DO m = -l,l
89 2334185 : lm = ll1 + m
90 2334185 : ctmp=term1*conjg(ylm(ll1+m+1))*work(i)
91 2334185 : acof(i,lm,na_l) = acof(i,lm,na_l) + ctmp*alo1(lo)
92 2334185 : bcof(i,lm,na_l) = bcof(i,lm,na_l) + ctmp*blo1(lo)
93 3195062 : ccof(m,i,lo,na_l) = ccof(m,i,lo,na_l) + ctmp*clo1(lo)
94 : END DO
95 : !!$acc end loop
96 : END DO
97 : !!$acc end loop
98 : !!$acc end kernels
99 :
100 46170 : IF (l_force) THEN
101 3328 : DO i = 1,ne
102 11488 : DO m = -l,l
103 8160 : lm = ll1 + m
104 8160 : ctmp=term1*conjg(ylm(ll1+m+1))*work(i)
105 8160 : force%acoflo(m,i,lo,na) = force%acoflo(m,i,lo,na) + ctmp*alo1(lo)
106 8160 : force%bcoflo(m,i,lo,na) = force%bcoflo(m,i,lo,na) + ctmp*blo1(lo)
107 35904 : DO j = 1,3
108 24480 : force%aveccof(j,i,lm,na) = force%aveccof(j,i,lm,na) + fgp(j)*ctmp*alo1(lo)
109 24480 : force%bveccof(j,i,lm,na) = force%bveccof(j,i,lm,na) + fgp(j)*ctmp*blo1(lo)
110 32640 : force%cveccof(j,m,i,lo,na) = force%cveccof(j,m,i,lo,na) + fgp(j)*ctmp*clo1(lo)
111 : END DO
112 : END DO
113 : END DO
114 : END IF
115 46170 : END SUBROUTINE abclocdn
116 : END MODULE m_abclocdn
|