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 : #ifdef _OPENACC
7 : #define CPP_OMP !no OMP
8 : #define CPP_ACC $acc
9 : #else
10 : #define CPP_OMP $OMP
11 : #define CPP_ACC !no ACC
12 : #endif
13 : MODULE m_hsmt_lo
14 : USE m_juDFT
15 : IMPLICIT NONE
16 : PRIVATE
17 : PUBLIC hsmt_lo
18 : CONTAINS
19 17948 : SUBROUTINE hsmt_lo(Input,Atoms,Sym,Cell,fmpi,Noco,nococonv,Lapw,Ud,Tlmplm,FjGj,N,Chi,ilSpinPr,ilSpin,igSpinPr,igSpin,Hmat,set0,l_fullj,l_ham,Smat,lapwq,fjgjq)
20 : USE m_hlomat
21 : USE m_slomat
22 : USE m_setabc1lo
23 : USE m_types_mpimat
24 : USE m_types
25 : USE m_hsmt_fjgj
26 : IMPLICIT NONE
27 : TYPE(t_mpi),INTENT(IN) :: fmpi
28 : TYPE(t_input),INTENT(IN) :: input
29 : TYPE(t_noco),INTENT(IN) :: noco
30 : TYPE(t_nococonv),INTENT(IN) :: nococonv
31 : TYPE(t_sym),INTENT(IN) :: sym
32 : TYPE(t_cell),INTENT(IN) :: cell
33 : TYPE(t_atoms),INTENT(IN) :: atoms
34 : TYPE(t_lapw),INTENT(IN) :: lapw
35 : TYPE(t_usdus),INTENT(IN) :: ud
36 : TYPE(t_tlmplm),INTENT(IN) :: tlmplm
37 : TYPE(t_fjgj),INTENT(IN) :: fjgj
38 : LOGICAL,INTENT(IN) :: l_fullj, l_ham, set0 !if true, initialize the LO-part of the matrices with zeros
39 : TYPE(t_lapw),OPTIONAL,INTENT(IN) :: lapwq
40 : TYPE(t_fjgj), OPTIONAL, INTENT(IN) :: fjgjq
41 :
42 : CLASS(t_mat),INTENT(INOUT)::hmat
43 : CLASS(t_mat),INTENT(INOUT),OPTIONAL::smat
44 :
45 : ! ..
46 : ! .. Scalar Arguments ..
47 : INTEGER,INTENT(IN) :: n
48 : INTEGER, INTENT (IN) :: ilSpinPr,ilSpin,igSpinPr,igSpin !spins
49 : COMPLEX, INTENT(IN) :: chi
50 :
51 : ! ..
52 : ! .. Local Scalars ..
53 : INTEGER na,nn,usp
54 : INTEGER l,nkvec,kp
55 : ! ..
56 : ! .. Local Arrays ..
57 17948 : REAL alo1(atoms%nlod,input%jspins),blo1(atoms%nlod,input%jspins),clo1(atoms%nlod,input%jspins)
58 17948 : CALL timestart("LO setup")
59 17948 : call timestart("Preparation")
60 17948 : IF (set0) THEN
61 : SELECT TYPE (hmat)
62 : TYPE IS (t_mpimat)
63 1844 : l = hmat%global_size2
64 : CLASS DEFAULT
65 648 : l = hmat%matsize2
66 : END SELECT
67 :
68 : !CPP_OMP PARALLEL DEFAULT(none) &
69 : !CPP_OMP SHARED(fmpi,l,lapw,hmat,smat,igSpin) &
70 2492 : !CPP_OMP PRIVATE(nkvec,kp)
71 : !CPP_OMP DO
72 : !CPP_ACC kernels present(hmat,hmat%data_r,hmat%data_c)copyin(fmpi,lapw,lapw%nv)
73 : DO nkvec = fmpi%n_rank+1, l, fmpi%n_size
74 : IF( nkvec > lapw%nv(igSpin)) THEN
75 : kp=(nkvec-1)/fmpi%n_size+1
76 : IF (hmat%l_real) THEN
77 : hmat%data_r(:,kp) = 0.0
78 : ELSE
79 : hmat%data_c(:,kp) = CMPLX(0.0,0.0)
80 : ENDIF
81 : ENDIF
82 : ENDDO
83 : !CPP_ACC end kernels
84 : !CPP_OMP END DO
85 : IF ( present(smat)) THEN
86 : !CPP_OMP DO
87 : !CPP_ACC kernels present(smat,smat%data_r,smat%data_c)copyin(fmpi,lapw,lapw%nv)
88 : DO nkvec = fmpi%n_rank+1, l, fmpi%n_size
89 : IF( nkvec > lapw%nv(igSpin)) THEN
90 : kp=(nkvec-1)/fmpi%n_size+1
91 : IF (smat%l_real) THEN
92 : smat%data_r(:,kp) = 0.0
93 : ELSE
94 : smat%data_c(:,kp) = CMPLX(0.0,0.0)
95 : ENDIF
96 : ENDIF
97 : ENDDO
98 : !CPP_ACC end kernels
99 : !CPP_OMP END DO
100 : ENDIF
101 : !CPP_OMP END PARALLEL
102 : ENDIF
103 17948 : call timestop("Preparation")
104 :
105 17948 : na = atoms%firstAtom(n) - 1
106 36228 : DO nn = 1,atoms%neq(n)
107 18280 : na = na + 1
108 36228 : IF ((sym%invsat(na).EQ.0) .OR. (sym%invsat(na).EQ.1)) THEN
109 :
110 :
111 18112 : IF (atoms%nlo(n).GE.1) THEN
112 :
113 :
114 : !---> set up the a,b and c coefficients
115 : !---> for the local orbitals, if necessary.
116 : !---> actually, these are the fj,gj equivalents
117 23880 : DO usp=min(ilSpinPr,ilSpin),max(ilSpinPr,ilSpin)
118 23880 : CALL setabc1lo(atoms,n,ud,usp,alo1,blo1,clo1)
119 : enddo
120 :
121 : !---> add the local orbital contribution to the overlap and
122 : !---> hamiltonian matrix, if they are used for this atom.
123 11722 : call timestart("slomat")
124 11722 : IF (ilSpinPr==ilSpin) THEN
125 11286 : IF (.NOT.PRESENT(smat)) THEN
126 0 : IF (.NOT.PRESENT(lapwq)) CALL judft_error("Bug in hsmt_lo, called without smat")
127 : ELSE
128 11286 : IF (PRESENT(lapwq)) THEN
129 : CALL slomat(input,atoms,sym,fmpi,lapw,cell,nococonv,n,na,&
130 : ilSpinPr,ud, alo1(:,ilSpinPr),blo1(:,ilSpinPr),clo1(:,ilSpinPr),fjgj,&
131 0 : igSpinPr,igSpin,chi,smat,l_fullj,lapwq,fjgjq)
132 : ELSE
133 : CALL slomat(input,atoms,sym,fmpi,lapw,cell,nococonv,n,na,&
134 : ilSpinPr,ud, alo1(:,ilSpinPr),blo1(:,ilSpinPr),clo1(:,ilSpinPr),fjgj,&
135 11286 : igSpinPr,igSpin,chi,smat,l_fullj)
136 : END IF
137 : END IF
138 : END IF
139 11722 : call timestop("slomat")
140 11722 : CALL timestart("hlomat")
141 11722 : IF (PRESENT(lapwq)) THEN
142 : CALL hlomat(input,atoms,fmpi,lapw,ud,tlmplm,sym,cell,noco,nococonv,ilSpinPr,ilSpin,&
143 0 : n,na,fjgj,alo1,blo1,clo1,igSpinPr,igSpin,chi,hmat,l_fullj,l_ham,lapwq,fjgjq)
144 : ELSE
145 : CALL hlomat(input,atoms,fmpi,lapw,ud,tlmplm,sym,cell,noco,nococonv,ilSpinPr,ilSpin,&
146 11722 : n,na,fjgj,alo1,blo1,clo1,igSpinPr,igSpin,chi,hmat,l_fullj,l_ham)
147 : END IF
148 11722 : CALL timestop("hlomat")
149 : END IF
150 : END IF
151 : ! End loop over equivalent atoms
152 : END DO
153 17948 : CALL timestop("LO setup")
154 :
155 17948 : RETURN
156 : END SUBROUTINE hsmt_lo
157 :
158 2492 : END MODULE m_hsmt_lo
|
