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_types_tlmplm
8 : IMPLICIT NONE
9 : PRIVATE
10 : TYPE t_rsoc
11 : REAL,ALLOCATABLE,DIMENSION(:,:,:,:) :: rsopp,rsoppd,rsopdp,rsopdpd !(atoms%ntype,atoms%lmaxd,2,2)
12 : REAL,ALLOCATABLE,DIMENSION(:,:,:,:) :: rsoplop,rsoplopd,rsopdplo,rsopplo!(atoms%ntype,atoms%nlod,2,2)
13 : REAL,ALLOCATABLE,DIMENSION(:,:,:,:,:) :: rsoploplop !(atoms%ntype,atoms%nlod,nlod,2,2)
14 : COMPLEX,ALLOCATABLE,DIMENSION(:,:,:,:,:,:)::soangl
15 : END TYPE t_rsoc
16 :
17 : TYPE t_tlmplm
18 : COMPLEX,ALLOCATABLE :: tdulo(:,:,:,:,:)
19 : !(0:lmd,-llod:llod,mlotot,tspin)
20 : COMPLEX,ALLOCATABLE :: tuulo(:,:,:,:,:)
21 : COMPLEX,ALLOCATABLE :: tulou(:,:,:,:,:)
22 : COMPLEX,ALLOCATABLE :: tulod(:,:,:,:,:)
23 : !(0:lmd,-llod:llod,mlotot,tspin)
24 : COMPLEX,ALLOCATABLE :: tuloulo(:,:,:,:,:)
25 : COMPLEX,ALLOCATABLE :: tuloulo_newer(:,:,:,:,:,:,:)
26 : !(-llod:llod,-llod:llod,mlolotot,tspin)
27 : COMPLEX,ALLOCATABLE :: h_loc_LO(:,:,:,:,:) !lm,lmp,ntype,ispin,jspin
28 : COMPLEX,ALLOCATABLE :: h_LO(:,:,:,:,:) !lmp,m,lo+mlo,ispin,jspin
29 : COMPLEX,ALLOCATABLE :: h_LO2(:,:,:,:,:) !lmp,m,lo+mlo,ispin,jspin
30 : COMPLEX,ALLOCATABLE :: h_loc(:,:,:,:,:) !lm,lmp,ntype,ispin,jspin
31 : COMPLEX,ALLOCATABLE :: h_loc_nonsph(:,:,:,:,:) !lm,lmp,ntype,ispin,jspin
32 : INTEGER,ALLOCATABLE :: h_loc2(:)
33 : INTEGER,ALLOCATABLE :: h_loc2_nonsph(:)
34 :
35 : COMPLEX,ALLOCATABLE :: h_off(:,:,:,:,:) !l,lp,ntype,ispin,jspin)
36 : REAL,ALLOCATABLE :: e_shift(:,:)
37 : !COMPLEX,ALLOCATABLE :: h_loc_sp(:,:,:,:) !l,lp,ntype,ispin,jspin
38 : !COMPLEX,ALLOCATABLE :: h_locLO(:,:,:,:,:) !lm+mlo,mlo,ntype,ispin,jspin
39 : TYPE(t_rsoc) :: rsoc
40 : ! For juPhon:
41 : INTEGER,ALLOCATABLE :: ind(:,:,:,:)
42 : CONTAINS
43 : PROCEDURE,PASS :: init => tlmplm_init
44 : END TYPE t_tlmplm
45 : PUBLIC t_tlmplm,t_rsoc
46 : CONTAINS
47 748 : SUBROUTINE tlmplm_init(td,atoms,jspins,l_offdiag)
48 : USE m_judft
49 : USE m_types_atoms
50 : CLASS(t_tlmplm),INTENT(INOUT):: td
51 : TYPE(t_atoms) :: atoms
52 : INTEGER,INTENT(in) :: jspins
53 : LOGICAL,INTENT(IN) :: l_offdiag
54 : INTEGER :: err(11),lmd,mlolotot
55 748 : err = 0
56 2086 : mlolotot=DOT_PRODUCT(atoms%nlo,atoms%nlo+1)/2
57 748 : lmd=atoms%lmaxd*(atoms%lmaxd+2)
58 : !lmplmd=(lmd*(lmd+3))/2
59 :
60 2834 : td%h_loc2=atoms%lmax*(atoms%lmax+2)+1
61 2834 : td%h_loc2_nonsph=atoms%lnonsph*(atoms%lnonsph+2)+1
62 748 : IF (ALLOCATED(td%h_loc)) &
63 0 : DEALLOCATE(td%tdulo,td%tuulo,td%tulod,td%tulou,&
64 4 : td%tuloulo,td%tuloulo_newer,td%h_loc,td%e_shift,td%h_off,td%h_loc_nonsph,td%h_loc_LO,td%h_lo,td%h_lo2)
65 : ! ALLOCATE(td%tuu(0:lmplmd,ntype,jspins),stat=err)
66 : ! ALLOCATE(td%tud(0:lmplmd,ntype,jspins),stat=err)
67 : ! ALLOCATE(td%tdd(0:lmplmd,ntype,jspins),stat=err)
68 : ! ALLOCATE(td%tdu(0:lmplmd,ntype,jspins),stat=err)
69 881020 : ALLOCATE(td%tdulo(0:lmd,-atoms%llod:atoms%llod,SUM(atoms%nlo),jspins,jspins),stat=err(1));td%tdulo=0.0
70 881020 : ALLOCATE(td%tuulo(0:lmd,-atoms%llod:atoms%llod,SUM(atoms%nlo),jspins,jspins),stat=err(2));td%tuulo=0.0
71 881020 : ALLOCATE(td%tulod(0:lmd,-atoms%llod:atoms%llod,SUM(atoms%nlo),jspins,jspins),stat=err(8));td%tulod=0.0
72 881020 : ALLOCATE(td%tulou(0:lmd,-atoms%llod:atoms%llod,SUM(atoms%nlo),jspins,jspins),stat=err(9));td%tulou=0.0
73 72046 : ALLOCATE(td%tuloulo(-atoms%llod:atoms%llod,-atoms%llod:atoms%llod,MAX(mlolotot,1),jspins,jspins), stat=err(3));td%tuloulo=0.0
74 748 : mlolotot = DOT_PRODUCT(atoms%nlo,atoms%nlo)
75 105866 : ALLOCATE(td%tuloulo_newer(-atoms%llod:atoms%llod,-atoms%llod:atoms%llod,atoms%nlod,atoms%nlod,atoms%ntype,jspins,jspins), stat=err(11));td%tuloulo_newer=0.0
76 113880810 : ALLOCATE(td%h_loc(0:2*lmd+1,0:2*lmd+1,atoms%ntype,jspins,jspins),stat=err(5));td%h_loc=0.0
77 45341220 : ALLOCATE(td%h_loc_nonsph(0:MAXVAL(td%h_loc2_nonsph)*2-1,0:MAXVAL(td%h_loc2_nonsph)*2-1,atoms%ntype,jspins,jspins),stat=err(6));td%h_loc_nonsph=0.0
78 45341220 : ALLOCATE(td%h_loc_lo(0:MAXVAL(td%h_loc2_nonsph)*2-1,0:MAXVAL(td%h_loc2_nonsph)*2-1,atoms%ntype,jspins,jspins),stat=err(6));td%h_loc_lo=0.0
79 1115780 : ALLOCATE(td%h_lo(0:MAXVAL(td%h_loc2_nonsph)*2-1,-atoms%llod:atoms%llod,SUM(atoms%nlo),jspins,jspins),stat=err(6));td%h_lo=0.0
80 1115780 : ALLOCATE(td%h_lo2(0:MAXVAL(td%h_loc2_nonsph)*2-1,-atoms%llod:atoms%llod,SUM(atoms%nlo),jspins,jspins),stat=err(6));td%h_lo2=0.0
81 :
82 2992 : ALLOCATE(td%e_shift(atoms%ntype,jspins),stat=err(7))
83 748 : IF (l_offdiag) THEN
84 448 : ALLOCATE(td%h_off(0:2*atoms%lmaxd+1,0:2*atoms%lmaxd+1,atoms%ntype,2,2),stat=err(4))
85 : ELSE
86 684 : ALLOCATE(td%h_off(1,1,1,1,1),stat=err(4))
87 : END IF
88 152488 : td%h_off=0.0
89 8976 : IF (ANY(err.NE.0)) THEN
90 0 : WRITE (*,*) 'an error occured during allocation of'
91 0 : WRITE (*,*) 'the tlmplm local matrix elements'
92 0 : WRITE (*,'(9i7)') err(:)
93 0 : CALL juDFT_error("eigen: Error during allocation of tlmplm",calledby ="types_tlmplm")
94 : ENDIF
95 748 : END SUBROUTINE tlmplm_init
96 :
97 0 : END MODULE m_types_tlmplm
|
