cdnpot_io_common.F90 8.99 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
!--------------------------------------------------------------------------------
! Copyright (c) 2017 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!
!!! This module contains common subroutines required for density IO
!!! as well as for potential IO
!!!
!!!                             GM'17
!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

MODULE m_cdnpot_io_common

   USE m_types
   USE m_juDFT
   USE m_cdnpot_io_hdf
#ifdef CPP_HDF
   USE hdf5
#endif

25
26
   IMPLICIT NONE

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
   CONTAINS

   SUBROUTINE compareStars(stars, refStars, l_same)

      TYPE(t_stars),INTENT(IN)  :: stars
      TYPE(t_stars),INTENT(IN)  :: refStars

      LOGICAL,      INTENT(OUT) :: l_same

      l_same = .TRUE.

      IF(ABS(stars%gmaxInit-refStars%gmaxInit).GT.1e-10) l_same = .FALSE.
      IF(stars%ng3.NE.refStars%ng3) l_same = .FALSE.
      IF(stars%ng2.NE.refStars%ng2) l_same = .FALSE.
      IF(stars%mx1.NE.refStars%mx1) l_same = .FALSE.
      IF(stars%mx2.NE.refStars%mx2) l_same = .FALSE.
      IF(stars%mx3.NE.refStars%mx3) l_same = .FALSE.

   END SUBROUTINE compareStars

   SUBROUTINE compareStepfunctions(stars, refStars, l_same)

      TYPE(t_stars),INTENT(IN)  :: stars
      TYPE(t_stars),INTENT(IN)  :: refStars

      LOGICAL,      INTENT(OUT) :: l_same

      l_same = .TRUE.

      IF(stars%ng3.NE.refStars%ng3) l_same = .FALSE.
      IF(stars%mx1.NE.refStars%mx1) l_same = .FALSE.
      IF(stars%mx2.NE.refStars%mx2) l_same = .FALSE.
      IF(stars%mx3.NE.refStars%mx3) l_same = .FALSE.

   END SUBROUTINE compareStepfunctions

63
   SUBROUTINE compareStructure(input, atoms, vacuum, cell, sym, refInput, refAtoms, refVacuum,&
64
                               refCell, refSym, l_same)
65

66
      TYPE(t_input),INTENT(IN)  :: input, refInput
67
68
69
      TYPE(t_atoms),INTENT(IN)  :: atoms, refAtoms
      TYPE(t_vacuum),INTENT(IN) :: vacuum, refVacuum
      TYPE(t_cell),INTENT(IN)   :: cell, refCell
70
      TYPE(t_sym),INTENT(IN)    :: sym, refSym
71
72
73

      LOGICAL,      INTENT(OUT) :: l_same

74
75
      INTEGER                   :: i

76
77
78
79
80
81
      l_same = .TRUE.

      IF(atoms%ntype.NE.refAtoms%ntype) l_same = .FALSE.
      IF(atoms%nat.NE.refAtoms%nat) l_same = .FALSE.
      IF(atoms%lmaxd.NE.refAtoms%lmaxd) l_same = .FALSE.
      IF(atoms%jmtd.NE.refAtoms%jmtd) l_same = .FALSE.
82
      IF(atoms%n_u.NE.refAtoms%n_u) l_same = .FALSE.
83
      IF(vacuum%dvac.NE.refVacuum%dvac) l_same = .FALSE.
84
85
86
      IF(sym%nop.NE.refSym%nop) l_same = .FALSE.
      IF(sym%nop2.NE.refSym%nop2) l_same = .FALSE.

87
88
89
90
91
92
93
      IF(atoms%n_u.EQ.refAtoms%n_u) THEN
         DO i = 1, atoms%n_u
            IF (atoms%lda_u(i)%atomType.NE.refAtoms%lda_u(i)%atomType) l_same = .FALSE.
            IF (atoms%lda_u(i)%l.NE.refAtoms%lda_u(i)%l) l_same = .FALSE.
         END DO
      END IF

94
95
96
      IF(ANY(ABS(cell%amat(:,:)-refCell%amat(:,:)).GT.1e-10)) l_same = .FALSE.
      IF(l_same) THEN
         IF(ANY(atoms%nz(:).NE.refAtoms%nz(:))) l_same = .FALSE.
97
98
         IF(ANY(sym%mrot(:,:,:sym%nop).NE.refSym%mrot(:,:,:sym%nop))) l_same = .FALSE.
         IF(ANY(ABS(sym%tau(:,:sym%nop)-refSym%tau(:,:sym%nop)).GT.1e-10)) l_same = .FALSE.
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
      END IF
      IF(l_same) THEN
         DO i = 1, atoms%nat
            IF(ANY(ABS(atoms%pos(:,i)-refAtoms%pos(:,i)).GT.1e-10)) l_same = .FALSE.
         END DO
      END IF

      ! NOTE: This subroutine certainly is not yet complete. Especially symmetry should
      !       also be stored and compared for structure considerations.

   END SUBROUTINE compareStructure

   SUBROUTINE compareLatharms(latharms, refLatharms, l_same)

      TYPE(t_sphhar)       :: latharms, refLatharms

      LOGICAL,      INTENT(OUT) :: l_same

      l_same = .TRUE.

      IF(latharms%ntypsd.NE.refLatharms%ntypsd) l_same = .FALSE.
      IF(latharms%memd.NE.refLatharms%memd) l_same = .FALSE.
      IF(latharms%nlhd.NE.refLatharms%nlhd) l_same = .FALSE.

   END SUBROUTINE compareLatharms

#ifdef CPP_HDF
   SUBROUTINE checkAndWriteMetadataHDF(fileID, input, atoms, cell, vacuum, oneD, stars, latharms, sym,&
                                       currentStarsIndex,currentLatharmsIndex,currentStructureIndex,&
128
                                       currentStepfunctionIndex,l_storeIndices,l_CheckBroyd)
129
130
131
132
133
134
135
136
137
138
139
140
141

      TYPE(t_input),INTENT(IN)  :: input
      TYPE(t_atoms),INTENT(IN)  :: atoms
      TYPE(t_cell), INTENT(IN)  :: cell
      TYPE(t_vacuum),INTENT(IN) :: vacuum
      TYPE(t_oneD),INTENT(IN)   :: oneD
      TYPE(t_stars),INTENT(IN)  :: stars
      TYPE(t_sphhar),INTENT(IN) :: latharms
      TYPE(t_sym),INTENT(IN)    :: sym

      INTEGER(HID_T), INTENT(IN) :: fileID
      INTEGER, INTENT(INOUT)     :: currentStarsIndex,currentLatharmsIndex
      INTEGER, INTENT(INOUT)     :: currentStructureIndex,currentStepfunctionIndex
142
      LOGICAL, INTENT(IN)        :: l_CheckBroyd
143
144
145
146
147
148
149
150
151
      LOGICAL, INTENT(OUT)       :: l_storeIndices

      TYPE(t_stars)        :: starsTemp
      TYPE(t_vacuum)       :: vacuumTemp
      TYPE(t_atoms)        :: atomsTemp
      TYPE(t_sphhar)       :: latharmsTemp
      TYPE(t_input)        :: inputTemp
      TYPE(t_cell)         :: cellTemp
      TYPE(t_oneD)         :: oneDTemp
152
      TYPE(t_sym)          :: symTemp
153

154
      INTEGER                    :: starsIndexTemp, structureIndexTemp
155
      LOGICAL                    :: l_same, l_writeAll, l_exist
156
157
158
159
160
161
162

      l_storeIndices = .FALSE.
      l_writeAll = .FALSE.

      IF(currentStructureIndex.EQ.0) THEN
         currentStructureIndex = 1
         l_storeIndices = .TRUE.
163
         CALL writeStructureHDF(fileID, input, atoms, cell, vacuum, oneD, sym, currentStructureIndex,l_CheckBroyd)
164
      ELSE
165
         CALL readStructureHDF(fileID, inputTemp, atomsTemp, cellTemp, vacuumTemp, oneDTemp, symTemp, currentStructureIndex)
166
         CALL compareStructure(input, atoms, vacuum, cell, sym, inputTemp, atomsTemp, vacuumTemp, cellTemp, symTemp, l_same)
167
168
169
170
171

         IF(.NOT.l_same) THEN
            currentStructureIndex = currentStructureIndex + 1
            l_storeIndices = .TRUE.
            l_writeAll = .TRUE.
172
            CALL writeStructureHDF(fileID, input, atoms, cell, vacuum, oneD, sym, currentStructureIndex,l_CheckBroyd)
173
174
175
176
177
         END IF
      END IF
      IF (currentStarsIndex.EQ.0) THEN
         currentStarsIndex = 1
         l_storeIndices = .TRUE.
178
         CALL writeStarsHDF(fileID, currentStarsIndex, currentStructureIndex, stars,l_CheckBroyd)
179
      ELSE
180
181
182
183
184
185
         CALL peekStarsHDF(fileID, currentStarsIndex, structureIndexTemp)
         l_same = structureIndexTemp.EQ.currentStructureIndex
         IF(l_same) THEN
            CALL readStarsHDF(fileID, currentStarsIndex, starsTemp)
            CALL compareStars(stars, starsTemp, l_same)
         END IF
186
187
188
         IF((.NOT.l_same).OR.l_writeAll) THEN
            currentStarsIndex = currentStarsIndex + 1
            l_storeIndices = .TRUE.
189
            CALL writeStarsHDF(fileID, currentStarsIndex, currentStructureIndex, stars,l_CheckBroyd)
190
191
192
193
194
         END IF
      END IF
      IF (currentLatharmsIndex.EQ.0) THEN
         currentLatharmsIndex = 1
         l_storeIndices = .TRUE.
195
         CALL writeLatharmsHDF(fileID, currentLatharmsIndex, currentStructureIndex, latharms,l_checkBroyd)
196
      ELSE
197
198
199
200
201
202
         CALL peekLatharmsHDF(fileID, currentLatharmsIndex, structureIndexTemp)
         l_same = structureIndexTemp.EQ.currentStructureIndex
         IF(l_same) THEN
            CALL readLatharmsHDF(fileID, currentLatharmsIndex, latharmsTemp)
            CALL compareLatharms(latharms, latharmsTemp, l_same)
         END IF
203
204
205
         IF((.NOT.l_same).OR.l_writeAll) THEN
            currentLatharmsIndex = currentLatharmsIndex + 1
            l_storeIndices = .TRUE.
206
            CALL writeLatharmsHDF(fileID, currentLatharmsIndex, currentStructureIndex, latharms,l_CheckBroyd)
207
208
209
210
211
         END IF
      END IF
      IF(currentStepfunctionIndex.EQ.0) THEN
         currentStepfunctionIndex = 1
         l_storeIndices = .TRUE.
212
         CALL writeStepfunctionHDF(fileID, currentStepfunctionIndex, currentStarsIndex,&
213
                                   currentStructureIndex, stars,l_CheckBroyd)
214
      ELSE
215
216
217
218
219
220
         CALL peekStepfunctionHDF(fileID, currentStepfunctionIndex, starsIndexTemp, structureIndexTemp)
         l_same = (starsIndexTemp.EQ.currentStarsIndex).AND.(structureIndexTemp.EQ.currentStructureIndex)
         IF(l_same) THEN
            CALL readStepfunctionHDF(fileID, currentStepfunctionIndex, starsTemp)
            CALL compareStepfunctions(stars, starsTemp, l_same)
         END IF
221
222
223
         IF((.NOT.l_same).OR.l_writeAll) THEN
            currentStepfunctionIndex = currentStepfunctionIndex + 1
            l_storeIndices = .TRUE.
224
            CALL writeStepfunctionHDF(fileID, currentStepfunctionIndex, currentStarsIndex,&
225
                                      currentStructureIndex, stars,l_CheckBroyd)
226
227
228
229
230
231
232
233
         END IF
      END IF

   END SUBROUTINE checkAndWriteMetadataHDF
#endif


END MODULE m_cdnpot_io_common