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_eig66_data
8 : use m_juDFT
9 : #ifdef CPP_HDF
10 : use hdf5
11 : #endif
12 : implicit none
13 :
14 : TYPE :: t_data
15 : INTEGER:: io_mode
16 : INTEGER:: jspins, nkpts, nmat, neig, nlo, ntype
17 : LOGICAL:: l_real, l_soc
18 : END TYPE
19 :
20 : TYPE, EXTENDS(t_data):: t_data_DA
21 : INTEGER :: recl_vec = 0, recl_wiks
22 : CHARACTER(LEN=20) :: fname = "eig"
23 : INTEGER :: file_io_id_vec, file_io_id_wiks
24 : END TYPE
25 :
26 : TYPE, extends(t_data):: t_data_MPI
27 : INTEGER :: n_size = 1
28 : INTEGER :: size_k, size_eig
29 : INTEGER :: eig_handle, zr_handle, zc_handle, neig_handle, olap_r_handle, olap_c_handle
30 : INTEGER, ALLOCATABLE :: pe_basis(:, :), slot_basis(:, :)
31 : INTEGER, ALLOCATABLE :: pe_ev(:, :, :), slot_ev(:, :, :)
32 : integer, allocatable :: pe_olap(:,:,:), slot_olap(:,:,:)
33 : INTEGER :: irank
34 : INTEGER, POINTER :: neig_data(:)
35 : REAL, POINTER :: eig_data(:), zr_data(:), olap_r_data(:)
36 : COMPLEX, POINTER :: zc_data(:), olap_c_data(:)
37 : END TYPE
38 : TYPE, EXTENDS(t_data):: t_data_hdf
39 : #ifdef CPP_HDF
40 : INTEGER(HID_T) :: fid
41 : INTEGER(HID_T) :: neigsetid
42 : INTEGER(HID_T) :: energysetid, wikssetid, evsetid
43 : CHARACTER(LEN=20) :: fname = "eig"
44 : #endif
45 : END TYPE
46 :
47 : TYPE, EXTENDS(t_data):: t_data_mem
48 : INTEGER, ALLOCATABLE :: eig_int(:)
49 : REAL, ALLOCATABLE :: eig_eig(:, :)
50 : REAL, ALLOCATABLE :: eig_vecr(:, :)
51 : COMPLEX, ALLOCATABLE :: eig_vecc(:, :)
52 : REAL, ALLOCATABLE :: olap_r(:, :)
53 : COMPLEX, ALLOCATABLE :: olap_c(:, :)
54 : END TYPE t_data_mem
55 :
56 : TYPE t_list
57 : INTEGER :: id
58 : CLASS(t_data), POINTER :: data
59 : TYPE(t_list), POINTER :: next => null()
60 : END TYPE
61 :
62 : TYPE(t_list), POINTER :: linked_list => null()
63 : private linked_list
64 : INTEGER, PARAMETER :: DA_mode = 0, HDF_mode = 1, MEM_mode = 2, MPI_mode = 3
65 :
66 : contains
67 :
68 154 : subroutine eig66_data_storedefault(d, jspins, nkpts, nmat, neig, l_real, l_soc)
69 : CLASS(t_data)::d
70 : INTEGER, INTENT(IN)::jspins, nkpts, nmat, neig
71 : LOGICAL, INTENT(IN):: l_real, l_soc
72 154 : d%jspins = jspins
73 154 : d%nkpts = nkpts
74 154 : d%nmat = nmat
75 154 : d%neig = neig
76 154 : d%l_real = l_real
77 154 : d%l_soc = l_soc
78 154 : END SUBROUTINE
79 :
80 20616 : subroutine eig66_find_data(d, id, io_mode)
81 : IMPLICIT NONE
82 : INTEGER, INTENT(IN) ::id
83 : INTEGER, INTENT(IN), OPTIONAL :: io_mode
84 : CLASS(t_data), pointer::d
85 :
86 : TYPE(t_list), POINTER, ASYNCHRONOUS:: listpointer, lastinlist
87 20616 : lastinlist => null()
88 :
89 20616 : listpointer => linked_list
90 20616 : DO WHILE (associated(listpointer))
91 20462 : lastinlist => listpointer
92 20462 : if (listpointer%id == id) THEN
93 20462 : d => listpointer%data
94 20462 : return
95 : endif
96 0 : listpointer => listpointer%next
97 : enddo
98 : !no pointer found
99 154 : IF (present(io_mode)) THEN
100 154 : IF (.not. associated(lastinlist)) THEN
101 154 : allocate (linked_list)
102 154 : linked_list%id = id
103 154 : lastinlist => linked_list
104 : ELSE
105 0 : allocate (lastinlist%next)
106 0 : lastinlist%next%id = id
107 0 : lastinlist => lastinlist%next
108 : ENDIF
109 154 : SELECT CASE (io_mode)
110 : case (DA_MODE)
111 0 : allocate (t_data_DA::lastinlist%data)
112 : case (HDF_MODE)
113 : #ifdef CPP_HDF
114 0 : allocate (t_data_HDF::lastinlist%data)
115 : #else
116 : call juDFT_error("Cannot use hdf mode for IO, recompile with CPP_HDF", calledby="eig66_data")
117 : #endif
118 : case (MEM_MODE)
119 0 : allocate (t_data_MEM::lastinlist%data)
120 : case (MPI_MODE)
121 154 : allocate (t_data_MPI::lastinlist%data)
122 : end select
123 154 : lastinlist%data%io_mode = io_mode
124 154 : d => lastinlist%data
125 : ELSE
126 0 : call juDFT_error("BUG:Could not find data object in eig66_mpi")
127 : ENDIF
128 : END SUBROUTINE
129 :
130 0 : subroutine eig66_remove_data(id)
131 : INTEGER, INTENT(IN)::id
132 :
133 : TYPE(t_list), POINTER:: listpointer, lastpointer
134 0 : lastpointer => null()
135 0 : listpointer => linked_list
136 0 : loop: DO WHILE (associated(listpointer))
137 0 : IF (listpointer%id == id) THEN
138 : exit loop
139 : ENDIF
140 0 : lastpointer => listpointer
141 0 : listpointer => listpointer%next
142 : ENDDO loop
143 :
144 0 : if (.not. associated(listpointer)) call juDFT_error("BUG in eig66_data: ID not found in deleting")
145 0 : IF (associated(lastpointer)) THEN
146 0 : lastpointer%next => listpointer%next
147 : ELSE
148 0 : linked_list => listpointer%next
149 : ENDIF
150 :
151 0 : deallocate (listpointer)
152 0 : end subroutine
153 :
154 154 : INTEGER FUNCTION eig66_data_newid(mode)
155 : INTEGER, INTENT(IN) :: mode
156 : TYPE(t_list), POINTER:: listpointer
157 : INTEGER :: id
158 : CLASS(t_data), POINTER::d
159 :
160 154 : id = 0
161 154 : listpointer => linked_list
162 154 : DO WHILE (associated(listpointer))
163 0 : id = max(id, listpointer%id)
164 0 : listpointer => listpointer%next
165 : ENDDO
166 154 : eig66_data_newid = id + 1
167 :
168 154 : call eig66_find_data(d, id + 1, mode)
169 :
170 154 : end function
171 :
172 20474 : INTEGER function eig66_data_mode(id) RESULT(mode)
173 : INTEGER, INTENT(IN) :: id
174 : TYPE(t_list), POINTER:: listpointer
175 :
176 20474 : mode = -1
177 20474 : listpointer => linked_list
178 :
179 20474 : DO WHILE (associated(listpointer))
180 20474 : if (id == listpointer%id) THEN
181 20474 : mode = listpointer%data%io_mode
182 20474 : return
183 : ENDIF
184 0 : listpointer => listpointer%next
185 : ENDDO
186 : END FUNCTION
187 :
188 154 : end module m_eig66_data
|
