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_usdus
8 : TYPE t_usdus
9 : REAL, ALLOCATABLE, DIMENSION(:, :, :) :: us
10 : REAL, ALLOCATABLE, DIMENSION(:, :, :) :: dus
11 : REAL, ALLOCATABLE, DIMENSION(:, :, :) :: uds
12 : REAL, ALLOCATABLE, DIMENSION(:, :, :) :: duds !(0:lmaxd,ntype,jspd)
13 : REAL, ALLOCATABLE, DIMENSION(:, :, :) :: ddn !(0:lmaxd,ntype,jspd)
14 : REAL, ALLOCATABLE, DIMENSION(:, :, :) :: ulos
15 : REAL, ALLOCATABLE, DIMENSION(:, :, :) :: dulos
16 : REAL, ALLOCATABLE, DIMENSION(:, :, :) :: uulon
17 : REAL, ALLOCATABLE, DIMENSION(:, :, :) :: dulon ! (nlod,ntype,jspd)
18 : REAL, ALLOCATABLE, DIMENSION(:, :, :, :) :: uloulopn ! (nlod,nlod,ntypd,jspd)
19 : REAL, ALLOCATABLE, DIMENSION(:, :, :) :: uuilon
20 : REAL, ALLOCATABLE, DIMENSION(:, :, :) :: duilon ! (nlod,ntype,jspd)
21 : REAL, ALLOCATABLE, DIMENSION(:, :, :, :) :: ulouilopn ! (nlod,nlod,ntypd,jspd)
22 : CONTAINS
23 : PROCEDURE :: init => usdus_init
24 : PROCEDURE :: free => usdus_free
25 : END TYPE t_usdus
26 :
27 : CONTAINS
28 1854 : SUBROUTINE usdus_init(ud, atoms, jsp)
29 : USE m_judft
30 : USE m_types_setup
31 : IMPLICIT NONE
32 : CLASS(t_usdus) :: ud
33 : TYPE(t_atoms), INTENT(IN) :: atoms
34 : INTEGER, INTENT(IN) :: jsp
35 :
36 : INTEGER :: err(13)
37 :
38 1854 : err = 0
39 1854 : if(.not. allocated(ud%uloulopn)) &
40 11064 : allocate(ud%uloulopn(atoms%nlod, atoms%nlod, atoms%ntype, jsp), stat=err(1))
41 1854 : if(.not. allocated(ud%ddn)) &
42 9220 : allocate(ud%ddn(0:atoms%lmaxd, atoms%ntype, jsp), stat=err(2))
43 1854 : if(.not. allocated(ud%us)) &
44 9220 : allocate(ud%us(0:atoms%lmaxd, atoms%ntype, jsp), stat=err(3))
45 1854 : if(.not. allocated(ud%uds)) &
46 9220 : allocate(ud%uds(0:atoms%lmaxd, atoms%ntype, jsp), stat=err(4))
47 1854 : if(.not. allocated(ud%dus)) &
48 9220 : allocate(ud%dus(0:atoms%lmaxd, atoms%ntype, jsp), stat=err(5))
49 1854 : if(.not. allocated(ud%duds)) &
50 9220 : allocate(ud%duds(0:atoms%lmaxd, atoms%ntype, jsp), stat=err(6))
51 1854 : if(.not. allocated(ud%ulos)) &
52 9220 : allocate(ud%ulos(atoms%nlod, atoms%ntype, jsp), stat=err(7))
53 1854 : if(.not. allocated(ud%dulos)) &
54 9220 : allocate(ud%dulos(atoms%nlod, atoms%ntype, jsp), stat=err(8))
55 1854 : if(.not. allocated(ud%uulon)) &
56 9220 : allocate(ud%uulon(atoms%nlod, atoms%ntype, jsp), stat=err(9))
57 1854 : if(.not. allocated(ud%dulon)) &
58 9220 : allocate(ud%dulon(atoms%nlod, atoms%ntype, jsp), stat=err(10))
59 1854 : if(.not. allocated(ud%uuilon)) &
60 9220 : allocate(ud%uuilon(atoms%nlod, atoms%ntype, jsp), stat=err(11))
61 1854 : if(.not. allocated(ud%duilon)) &
62 9220 : allocate(ud%duilon(atoms%nlod, atoms%ntype, jsp), stat=err(12))
63 1854 : if(.not. allocated(ud%ulouilopn)) &
64 11064 : allocate(ud%ulouilopn(atoms%nlod, atoms%nlod, atoms%ntype, jsp), stat=err(13))
65 :
66 : !write (*,*) "err array", err
67 25956 : IF(ANY(err > 0)) CALL judft_error("Not enough memory allocating usdus datatype")
68 :
69 144026 : ud%uloulopn = 0; ud%ddn = 0; ud%us = 0
70 177450 : ud%uds = 0; ud%dus = 0; ud%duds = 0
71 44682 : ud%ulos = 0; ud%dulos = 0; ud%uulon = 0
72 44682 : ud%dulon = 0; ud%uuilon = 0; ud%duilon = 0
73 26962 : ud%ulouilopn = 0
74 1854 : END SUBROUTINE usdus_init
75 :
76 0 : SUBROUTINE usdus_free(ud)
77 : IMPLICIT NONE
78 : CLASS(t_usdus) :: ud
79 :
80 0 : if(allocated(ud%uloulopn)) deallocate(ud%uloulopn)
81 0 : if(allocated(ud%ddn)) deallocate(ud%ddn)
82 0 : if(allocated(ud%us)) deallocate(ud%us)
83 0 : if(allocated(ud%uds)) deallocate(ud%uds)
84 0 : if(allocated(ud%dus)) deallocate(ud%dus)
85 0 : if(allocated(ud%duds)) deallocate(ud%duds)
86 0 : if(allocated(ud%ulos)) deallocate(ud%ulos)
87 0 : if(allocated(ud%dulos)) deallocate(ud%dulos)
88 0 : if(allocated(ud%uulon)) deallocate(ud%uulon)
89 0 : if(allocated(ud%dulon)) deallocate(ud%dulon)
90 0 : if(allocated(ud%uuilon)) deallocate(ud%uuilon)
91 0 : if(allocated(ud%duilon)) deallocate(ud%duilon)
92 0 : if(allocated(ud%ulouilopn)) deallocate(ud%ulouilopn)
93 :
94 0 : END SUBROUTINE usdus_free
95 :
96 0 : END MODULE m_types_usdus
|