Line data Source code
1 : !--------------------------------------------------------------------------------
2 : ! Copyright (c) 2017 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 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
8 : !!!
9 : !!! This module contains common subroutines required for density IO
10 : !!! as well as for potential IO
11 : !!!
12 : !!! GM'17
13 : !!!
14 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15 :
16 : MODULE m_cdnpot_io_common
17 :
18 :
19 : USE m_juDFT
20 : USE m_cdnpot_io_hdf
21 : #ifdef CPP_HDF
22 : USE hdf5
23 : #endif
24 :
25 : IMPLICIT NONE
26 :
27 : CONTAINS
28 :
29 193 : SUBROUTINE compareStars(stars, refStars, l_same)
30 : use m_types_stars
31 :
32 :
33 : TYPE(t_stars),INTENT(IN) :: stars
34 : TYPE(t_stars),INTENT(IN) :: refStars
35 :
36 :
37 :
38 : LOGICAL, INTENT(OUT) :: l_same
39 :
40 193 : l_same = .TRUE.
41 :
42 : !IF(ABS(stars%gmaxInit-refStars%gmaxInit).GT.1e-10) l_same = .FALSE.
43 0 : IF(stars%ng3.NE.refStars%ng3) l_same = .FALSE.
44 193 : IF(stars%ng2.NE.refStars%ng2) l_same = .FALSE.
45 193 : IF(stars%mx1.NE.refStars%mx1) l_same = .FALSE.
46 193 : IF(stars%mx2.NE.refStars%mx2) l_same = .FALSE.
47 193 : IF(stars%mx3.NE.refStars%mx3) l_same = .FALSE.
48 :
49 0 : END SUBROUTINE compareStars
50 :
51 0 : SUBROUTINE compareStepfunctions(stars, refStars, l_same)
52 : use m_types_stars
53 : TYPE(t_stars),INTENT(IN) :: stars
54 : TYPE(t_stars),INTENT(IN) :: refStars
55 :
56 : LOGICAL, INTENT(OUT) :: l_same
57 :
58 0 : l_same = .TRUE.
59 :
60 0 : IF(stars%ng3.NE.refStars%ng3) l_same = .FALSE.
61 0 : IF(stars%mx1.NE.refStars%mx1) l_same = .FALSE.
62 0 : IF(stars%mx2.NE.refStars%mx2) l_same = .FALSE.
63 0 : IF(stars%mx3.NE.refStars%mx3) l_same = .FALSE.
64 :
65 0 : END SUBROUTINE compareStepfunctions
66 :
67 257 : SUBROUTINE compareStructure(input, atoms, vacuum, cell, sym, refInput, refAtoms, refVacuum,&
68 : refCell, refSym, l_same,l_shift_only)
69 : use m_types_input
70 : use m_types_atoms
71 : use m_types_vacuum
72 : use m_types_cell
73 : use m_types_sym
74 :
75 :
76 : TYPE(t_input),INTENT(IN) :: input, refInput
77 : TYPE(t_atoms),INTENT(IN) :: atoms, refAtoms
78 : TYPE(t_vacuum),INTENT(IN) :: vacuum, refVacuum
79 : TYPE(t_cell),INTENT(IN) :: cell, refCell
80 : TYPE(t_sym),INTENT(IN) :: sym, refSym
81 :
82 : LOGICAL, INTENT(OUT) :: l_same
83 : LOGICAL,OPTIONAL,INTENT(OUT) ::l_shift_only
84 :
85 : INTEGER :: i
86 :
87 257 : l_same = .TRUE.
88 :
89 :
90 257 : IF(atoms%ntype.NE.refAtoms%ntype) l_same = .FALSE.
91 257 : IF(atoms%nat.NE.refAtoms%nat) l_same = .FALSE.
92 257 : IF(atoms%lmaxd.NE.refAtoms%lmaxd) l_same = .FALSE.
93 257 : IF(atoms%jmtd.NE.refAtoms%jmtd) l_same = .FALSE.
94 257 : IF(atoms%n_u.NE.refAtoms%n_u) l_same = .FALSE.
95 257 : IF(atoms%n_hia.NE.refAtoms%n_hia) l_same = .FALSE.
96 257 : IF(atoms%n_opc.NE.refAtoms%n_opc) l_same = .FALSE.
97 257 : IF(input%ldauSpinoffd.NEQV.refInput%ldauSpinoffd) l_same = .FALSE.
98 257 : IF(vacuum%dvac.NE.refVacuum%dvac) l_same = .FALSE.
99 257 : IF(sym%nop.NE.refSym%nop) l_same = .FALSE.
100 257 : IF(sym%nop2.NE.refSym%nop2) l_same = .FALSE.
101 :
102 257 : IF(atoms%n_u.EQ.refAtoms%n_u.AND.atoms%n_hia.EQ.refAtoms%n_hia) THEN
103 381 : DO i = 1, atoms%n_u+atoms%n_hia
104 124 : IF (atoms%lda_u(i)%atomType.NE.refAtoms%lda_u(i)%atomType) l_same = .FALSE.
105 381 : IF (atoms%lda_u(i)%l.NE.refAtoms%lda_u(i)%l) l_same = .FALSE.
106 : END DO
107 : END IF
108 :
109 257 : IF(atoms%n_opc.EQ.refAtoms%n_opc) THEN
110 285 : DO i = 1, atoms%n_opc
111 28 : IF (atoms%lda_opc(i)%atomType.NE.refAtoms%lda_opc(i)%atomType) l_same = .FALSE.
112 28 : IF (atoms%lda_opc(i)%l.NE.refAtoms%lda_opc(i)%l) l_same = .FALSE.
113 285 : IF (atoms%lda_opc(i)%n.NE.refAtoms%lda_opc(i)%n) l_same = .FALSE.
114 : END DO
115 : END IF
116 :
117 3341 : IF(ANY(ABS(cell%amat(:,:)-refCell%amat(:,:)).GT.1e-10)) l_same = .FALSE.
118 257 : IF(l_same) THEN
119 735 : IF(ANY(atoms%nz(:).NE.refAtoms%nz(:))) l_same = .FALSE.
120 49124 : IF(ANY(sym%mrot(:,:,:sym%nop).NE.refSym%mrot(:,:,:sym%nop))) l_same = .FALSE.
121 15293 : IF(ANY(ABS(sym%tau(:,:sym%nop)-refSym%tau(:,:sym%nop)).GT.1e-10)) l_same = .FALSE.
122 : END IF
123 :
124 257 : IF (PRESENT(l_shift_only)) l_shift_only=l_same
125 : !Now the positions are checked...
126 257 : IF(l_same) THEN
127 894 : DO i = 1, atoms%nat
128 2805 : IF(ANY(ABS(atoms%pos(:,i)-refAtoms%pos(:,i)).GT.1e-10)) l_same = .FALSE.
129 : END DO
130 735 : IF(ANY(ABS(atoms%rmt(:atoms%ntype)-refAtoms%rmt(:atoms%ntype)).GT.1e-10)) l_same = .FALSE.
131 : END IF
132 :
133 : ! NOTE: This subroutine certainly is not yet complete. Especially symmetry should
134 : ! also be stored and compared for structure considerations.
135 :
136 257 : END SUBROUTINE compareStructure
137 :
138 193 : SUBROUTINE compareLatharms(latharms, refLatharms, l_same)
139 : use m_types_sphhar
140 : TYPE(t_sphhar) :: latharms, refLatharms
141 :
142 : LOGICAL, INTENT(OUT) :: l_same
143 :
144 193 : l_same = .TRUE.
145 :
146 0 : IF(latharms%ntypsd.NE.refLatharms%ntypsd) l_same = .FALSE.
147 193 : IF(latharms%memd.NE.refLatharms%memd) l_same = .FALSE.
148 193 : IF(latharms%nlhd.NE.refLatharms%nlhd) l_same = .FALSE.
149 :
150 0 : END SUBROUTINE compareLatharms
151 :
152 : #ifdef CPP_HDF
153 239 : SUBROUTINE checkAndWriteMetadataHDF(fileID, input, atoms, cell, vacuum, stars, latharms, sym,&
154 : currentStarsIndex,currentLatharmsIndex,currentStructureIndex,&
155 : currentStepfunctionIndex,l_storeIndices,l_CheckBroyd,l_storeAddMetadata)
156 : use m_types_atoms
157 : use m_types_input
158 : use m_types_cell
159 : use m_types_vacuum
160 :
161 : use m_types_stars
162 : use m_types_sphhar
163 : use m_types_sym
164 :
165 : TYPE(t_input),INTENT(IN) :: input
166 : TYPE(t_atoms),INTENT(IN) :: atoms
167 : TYPE(t_cell), INTENT(IN) :: cell
168 : TYPE(t_vacuum),INTENT(IN) :: vacuum
169 :
170 : TYPE(t_stars),INTENT(IN) :: stars
171 : TYPE(t_sphhar),INTENT(IN) :: latharms
172 : TYPE(t_sym),INTENT(IN) :: sym
173 :
174 : INTEGER(HID_T), INTENT(IN) :: fileID
175 : INTEGER, INTENT(INOUT) :: currentStarsIndex,currentLatharmsIndex
176 : INTEGER, INTENT(INOUT) :: currentStructureIndex,currentStepfunctionIndex
177 : LOGICAL, INTENT(IN) :: l_CheckBroyd
178 : LOGICAL, INTENT(OUT) :: l_storeIndices
179 : LOGICAL, INTENT(IN) :: l_storeAddMetadata
180 :
181 956 : TYPE(t_stars) :: starsTemp
182 239 : TYPE(t_vacuum) :: vacuumTemp
183 239 : TYPE(t_atoms) :: atomsTemp
184 239 : TYPE(t_sphhar) :: latharmsTemp
185 : TYPE(t_input) :: inputTemp
186 : TYPE(t_cell) :: cellTemp
187 :
188 239 : TYPE(t_sym) :: symTemp
189 :
190 : INTEGER :: starsIndexTemp, structureIndexTemp
191 : LOGICAL :: l_same, l_writeAll, l_exist
192 :
193 239 : l_storeIndices = .FALSE.
194 239 : l_writeAll = .FALSE.
195 :
196 239 : IF(currentStructureIndex.EQ.0) THEN
197 1 : currentStructureIndex = 1
198 1 : l_storeIndices = .TRUE.
199 1 : CALL writeStructureHDF(fileID, input, atoms, cell, vacuum, sym,currentStructureIndex,l_CheckBroyd)
200 : ELSE
201 238 : CALL readStructureHDF(fileID, inputTemp, atomsTemp, cellTemp, vacuumTemp, symTemp, currentStructureIndex)
202 238 : CALL compareStructure(input, atoms, vacuum, cell, sym, inputTemp, atomsTemp, vacuumTemp, cellTemp, symTemp, l_same)
203 :
204 238 : IF(.NOT.l_same) THEN
205 0 : currentStructureIndex = currentStructureIndex + 1
206 0 : l_storeIndices = .TRUE.
207 0 : l_writeAll = .TRUE.
208 0 : CALL writeStructureHDF(fileID, input, atoms, cell, vacuum, sym, currentStructureIndex,l_CheckBroyd)
209 : END IF
210 : END IF
211 239 : IF (currentStarsIndex.EQ.0) THEN
212 46 : currentStarsIndex = 1
213 46 : l_storeIndices = .TRUE.
214 46 : CALL writeStarsHDF(fileID, currentStarsIndex, currentStructureIndex, stars, l_CheckBroyd, l_storeAddMetadata)
215 : ELSE
216 193 : CALL peekStarsHDF(fileID, currentStarsIndex, structureIndexTemp)
217 193 : l_same = structureIndexTemp.EQ.currentStructureIndex
218 193 : IF(l_same) THEN
219 193 : CALL readStarsHDF(fileID, currentStarsIndex, starsTemp)
220 193 : CALL compareStars(stars, starsTemp, l_same)
221 : END IF
222 193 : IF((.NOT.l_same).OR.l_writeAll) THEN
223 0 : currentStarsIndex = currentStarsIndex + 1
224 0 : l_storeIndices = .TRUE.
225 0 : CALL writeStarsHDF(fileID, currentStarsIndex, currentStructureIndex, stars, l_CheckBroyd, l_storeAddMetadata)
226 : END IF
227 : END IF
228 239 : IF (currentLatharmsIndex.EQ.0) THEN
229 46 : currentLatharmsIndex = 1
230 46 : l_storeIndices = .TRUE.
231 46 : CALL writeLatharmsHDF(fileID, currentLatharmsIndex, currentStructureIndex, latharms,l_checkBroyd)
232 : ELSE
233 193 : CALL peekLatharmsHDF(fileID, currentLatharmsIndex, structureIndexTemp)
234 193 : l_same = structureIndexTemp.EQ.currentStructureIndex
235 193 : IF(l_same) THEN
236 193 : CALL readLatharmsHDF(fileID, currentLatharmsIndex, latharmsTemp)
237 193 : CALL compareLatharms(latharms, latharmsTemp, l_same)
238 : END IF
239 193 : IF((.NOT.l_same).OR.l_writeAll) THEN
240 0 : currentLatharmsIndex = currentLatharmsIndex + 1
241 0 : l_storeIndices = .TRUE.
242 0 : CALL writeLatharmsHDF(fileID, currentLatharmsIndex, currentStructureIndex, latharms,l_CheckBroyd)
243 : END IF
244 : END IF
245 239 : IF(currentStepfunctionIndex.EQ.0) THEN
246 239 : IF (judft_was_argument("-storeSF")) THEN
247 0 : currentStepfunctionIndex = 1
248 0 : l_storeIndices = .TRUE.
249 : CALL writeStepfunctionHDF(fileID, currentStepfunctionIndex, currentStarsIndex,&
250 0 : currentStructureIndex, stars,l_CheckBroyd)
251 : END IF
252 : ELSE
253 0 : CALL peekStepfunctionHDF(fileID, currentStepfunctionIndex, starsIndexTemp, structureIndexTemp)
254 0 : l_same = (starsIndexTemp.EQ.currentStarsIndex).AND.(structureIndexTemp.EQ.currentStructureIndex)
255 0 : IF(l_same) THEN
256 0 : CALL readStepfunctionHDF(fileID, currentStepfunctionIndex, starsTemp)
257 0 : CALL compareStepfunctions(stars, starsTemp, l_same)
258 : END IF
259 0 : IF((.NOT.l_same).OR.l_writeAll) THEN
260 0 : l_storeIndices = .TRUE.
261 : ! I comment out the IF condition. At the moment the logic is if there already is a stepfunction stored, we store more.
262 : ! IF (judft_was_argument("-storeSF")) THEN
263 0 : currentStepfunctionIndex = currentStepfunctionIndex + 1
264 : CALL writeStepfunctionHDF(fileID, currentStepfunctionIndex, currentStarsIndex,&
265 0 : currentStructureIndex, stars,l_CheckBroyd)
266 : ! ELSE
267 : ! currentStepfunctionIndex = 0 ! This is not safe, because one might resume to storing stepfunctions which would result in using index 1 twice.
268 : ! END IF
269 : END IF
270 : END IF
271 :
272 13145 : END SUBROUTINE checkAndWriteMetadataHDF
273 : #endif
274 :
275 :
276 : END MODULE m_cdnpot_io_common
|
