Line data Source code
1 : MODULE m_greensf_io
2 :
3 : #ifdef CPP_HDF
4 :
5 : USE hdf5
6 : USE m_hdf_tools
7 : USE m_types
8 : USE m_types_selfen
9 : USE m_constants
10 : USE m_juDFT
11 :
12 : IMPLICIT NONE
13 :
14 : PUBLIC openGreensFFile, closeGreensFFile, writeGreensFData
15 :
16 : PUBLIC GREENSF_GENERAL_CONST, GREENSF_HUBBARD_CONST
17 :
18 : !---------------
19 : ! Storage Types
20 : !-------------------------------
21 : ! GREENS_GENERAL_CONST => All Green's function elements are saved
22 : ! GREENS_HUBBARD_CONST => Only Hubbard elements are saved with selfenergy (if available)
23 : INTEGER, PARAMETER :: GREENSF_GENERAL_CONST = 1
24 : INTEGER, PARAMETER :: GREENSF_HUBBARD_CONST = 2
25 :
26 : CONTAINS
27 :
28 21 : SUBROUTINE openGreensFFile(fileID, input, gfinp, atoms, sym, cell, kpts, sphhar,inFilename, vtot)
29 :
30 : USE m_types
31 : USE m_cdn_io
32 : use m_lattHarmsSphHarmsConv
33 :
34 : TYPE(t_input), INTENT(IN) :: input
35 : TYPE(t_gfinp), INTENT(IN) :: gfinp
36 : TYPE(t_atoms), INTENT(IN) :: atoms
37 : type(t_sym), intent(in) :: sym
38 : TYPE(t_cell), INTENT(IN) :: cell
39 : TYPE(t_kpts), INTENT(IN) :: kpts
40 : type(t_sphhar), intent(in) :: sphhar
41 : TYPE(t_potden), optional, INTENT(IN) :: vtot
42 : CHARACTER(len=*), OPTIONAL, INTENT(IN) :: inFilename
43 : INTEGER(HID_T), INTENT(OUT) :: fileID
44 :
45 : LOGICAL :: l_exist
46 : CHARACTER(LEN=30) :: filename
47 : INTEGER(HID_T) :: metaGroupID
48 : INTEGER(HID_T) :: generalGroupID, kptsGroupID
49 : INTEGER(HID_T) :: kptCoordSpaceID, kptCoordSetID
50 : INTEGER(HID_T) :: kptWeightSpaceID, kptWeightSetID
51 : INTEGER(HID_T) :: kptsSPLabelsSpaceID, kptsSPLabelsSetID
52 : INTEGER(HID_T) :: kptsSPIndicesSpaceID, kptsSPIndicesSetID
53 : INTEGER(HID_T) :: bravaisMatrixSpaceID, bravaisMatrixSetID
54 : INTEGER(HID_T) :: reciprocalCellSpaceID, reciprocalCellSetID
55 : INTEGER(HID_T) :: atomsGroupID
56 : INTEGER(HID_T) :: atomPosSpaceID, atomPosSetID
57 : INTEGER(HID_T) :: atomicNumbersSpaceID, atomicNumbersSetID
58 : INTEGER(HID_T) :: equivAtomsClassSpaceID, equivAtomsClassSetID
59 : INTEGER(HID_T) :: bxcGroupID, bxcSpaceID, bxcSetID
60 :
61 : INTEGER(HID_T) :: stringTypeID
62 : INTEGER(SIZE_T) :: stringLength
63 :
64 : LOGICAL :: l_error
65 : INTEGER :: hdfError
66 : INTEGER :: version
67 : REAL :: eFermiPrev
68 : INTEGER :: dimsInt(7)
69 : INTEGER(HSIZE_T) :: dims(7)
70 : INTEGER :: j, iAtom, iType
71 :
72 21 : INTEGER :: atomicNumbers(atoms%nat)
73 21 : INTEGER :: equivAtomsGroup(atoms%nat)
74 21 : real, ALLOCATABLE :: bxc_mt(:,:,:)
75 21 : complex, allocatable :: bxc_lm(:,:,:)
76 :
77 21 : version = 10
78 21 : IF(PRESENT(inFilename)) THEN
79 0 : filename = TRIM(ADJUSTL(inFilename))
80 : ELSE
81 21 : filename = "greensf.hdf"
82 : ENDIF
83 :
84 21 : INQUIRE(FILE=TRIM(ADJUSTL(filename)),EXIST=l_exist)
85 21 : IF(l_exist) THEN
86 5 : CALL system('rm '//TRIM(ADJUSTL(filename)))
87 : ENDIF
88 :
89 21 : CALL h5fcreate_f(TRIM(ADJUSTL(filename)), H5F_ACC_TRUNC_F, fileID, hdfError, H5P_DEFAULT_F, H5P_DEFAULT_F)
90 :
91 21 : CALL h5gcreate_f(fileID, '/meta', metaGroupID, hdfError)
92 21 : CALL io_write_attint0(metaGroupID,'version',version)
93 :
94 21 : CALL h5gclose_f(metaGroupID, hdfError)
95 :
96 21 : CALL readPrevEFermi(eFermiPrev,l_error)
97 21 : IF(l_error) THEN
98 : ! No previous eFermi available
99 0 : eFermiPrev = 0.0
100 : END IF
101 :
102 21 : CALL h5gcreate_f(fileID, '/general', generalGroupID, hdfError)
103 21 : CALL io_write_attint0(generalGroupID,'spins',input%jspins)
104 21 : CALL io_write_attreal0(generalGroupID,'FermiEnergy',eFermiPrev)
105 21 : CALL io_write_attlog0(generalGroupID,'mperp',gfinp%l_mperp)
106 :
107 63 : dims(:2)=(/3,3/)
108 168 : dimsInt=dims
109 21 : CALL h5screate_simple_f(2,dims(:2),bravaisMatrixSpaceID,hdfError)
110 21 : CALL h5dcreate_f(generalGroupID, "bravaisMatrix", H5T_NATIVE_DOUBLE, bravaisMatrixSpaceID, bravaisMatrixSetID, hdfError)
111 21 : CALL h5sclose_f(bravaisMatrixSpaceID,hdfError)
112 21 : CALL io_write_real2(bravaisMatrixSetID,(/1,1/),dimsInt(:2),"amat",cell%amat)
113 21 : CALL h5dclose_f(bravaisMatrixSetID, hdfError)
114 :
115 63 : dims(:2)=(/3,3/)
116 168 : dimsInt=dims
117 21 : CALL h5screate_simple_f(2,dims(:2),reciprocalCellSpaceID,hdfError)
118 21 : CALL h5dcreate_f(generalGroupID, "reciprocalCell", H5T_NATIVE_DOUBLE, reciprocalCellSpaceID, reciprocalCellSetID, hdfError)
119 21 : CALL h5sclose_f(reciprocalCellSpaceID,hdfError)
120 21 : CALL io_write_real2(reciprocalCellSetID,(/1,1/),dimsInt(:2),"bmat",cell%bmat)
121 21 : CALL h5dclose_f(reciprocalCellSetID, hdfError)
122 :
123 21 : iAtom = 0
124 47 : DO iType = 1, atoms%ntype
125 73 : DO j = 1, atoms%neq(iType)
126 26 : iAtom = iAtom + 1
127 26 : atomicNumbers(iAtom) = atoms%nz(iType)
128 52 : equivAtomsGroup(iAtom) = iType
129 : END DO
130 : END DO
131 :
132 21 : CALL h5gcreate_f(fileID, '/atoms', atomsGroupID, hdfError)
133 21 : CALL io_write_attint0(atomsGroupID,'nAtoms',atoms%nat)
134 21 : CALL io_write_attint0(atomsGroupID,'nTypes',atoms%ntype)
135 :
136 63 : dims(:2)=(/3,atoms%nat/)
137 168 : dimsInt=dims
138 21 : CALL h5screate_simple_f(2,dims(:2),atomPosSpaceID,hdfError)
139 21 : CALL h5dcreate_f(atomsGroupID, "positions", H5T_NATIVE_DOUBLE, atomPosSpaceID, atomPosSetID, hdfError)
140 21 : CALL h5sclose_f(atomPosSpaceID,hdfError)
141 21 : CALL io_write_real2(atomPosSetID,(/1,1/),dimsInt(:2),"taual",atoms%taual)
142 21 : CALL h5dclose_f(atomPosSetID, hdfError)
143 :
144 42 : dims(:1)=(/atoms%nat/)
145 168 : dimsInt=dims
146 21 : CALL h5screate_simple_f(1,dims(:1),atomicNumbersSpaceID,hdfError)
147 21 : CALL h5dcreate_f(atomsGroupID, "atomicNumbers", H5T_NATIVE_INTEGER, atomicNumbersSpaceID, atomicNumbersSetID, hdfError)
148 21 : CALL h5sclose_f(atomicNumbersSpaceID,hdfError)
149 21 : CALL io_write_integer1(atomicNumbersSetID,(/1/),dimsInt(:1),"atomicNumbers",atomicNumbers)
150 21 : CALL h5dclose_f(atomicNumbersSetID, hdfError)
151 :
152 42 : dims(:1)=(/atoms%nat/)
153 168 : dimsInt=dims
154 21 : CALL h5screate_simple_f(1,dims(:1),equivAtomsClassSpaceID,hdfError)
155 21 : CALL h5dcreate_f(atomsGroupID, "equivAtomsGroup", H5T_NATIVE_INTEGER, equivAtomsClassSpaceID, equivAtomsClassSetID, hdfError)
156 21 : CALL h5sclose_f(equivAtomsClassSpaceID,hdfError)
157 21 : CALL io_write_integer1(equivAtomsClassSetID,(/1/),dimsInt(:1),"equivAtomsGroup",equivAtomsGroup)
158 21 : CALL h5dclose_f(equivAtomsClassSetID, hdfError)
159 :
160 21 : CALL h5gclose_f(atomsGroupID, hdfError)
161 :
162 21 : CALL h5gcreate_f(generalGroupID, 'kpts', kptsGroupID, hdfError)
163 :
164 21 : CALL io_write_attint0(kptsGroupID,'nkpt',kpts%nkpt)
165 21 : CALL io_write_attchar0(kptsGroupID,'kind',TRIM(ADJUSTL(kptsKindString_consts(kpts%kptsKind))))
166 21 : CALL io_write_attint0(kptsGroupID,'nSpecialPoints',kpts%numSpecialPoints)
167 :
168 63 : dims(:2)=(/3,kpts%nkpt/)
169 168 : dimsInt=dims
170 21 : CALL h5screate_simple_f(2,dims(:2),kptCoordSpaceID,hdfError)
171 21 : CALL h5dcreate_f(kptsGroupID, "coordinates", H5T_NATIVE_DOUBLE, kptCoordSpaceID, kptCoordSetID, hdfError)
172 21 : CALL h5sclose_f(kptCoordSpaceID,hdfError)
173 21 : CALL io_write_real2(kptCoordSetID,(/1,1/),dimsInt(:2),"bk",kpts%bk)
174 21 : CALL h5dclose_f(kptCoordSetID, hdfError)
175 :
176 42 : dims(:1)=(/kpts%nkpt/)
177 168 : dimsInt=dims
178 21 : CALL h5screate_simple_f(1,dims(:1),kptWeightSpaceID,hdfError)
179 21 : CALL h5dcreate_f(kptsGroupID, "weights", H5T_NATIVE_DOUBLE, kptWeightSpaceID, kptWeightSetID, hdfError)
180 21 : CALL h5sclose_f(kptWeightSpaceID,hdfError)
181 21 : CALL io_write_real1(kptWeightSetID,(/1/),dimsInt(:1),"wkpt",kpts%wtkpt)
182 21 : CALL h5dclose_f(kptWeightSetID, hdfError)
183 :
184 21 : IF (ALLOCATED(kpts%specialPointIndices)) THEN
185 0 : stringLength = LEN(kpts%specialPointNames(:))
186 0 : CALL h5tcopy_f(H5T_NATIVE_CHARACTER, stringTypeID, hdfError)
187 0 : CALL h5tset_size_f(stringTypeID, stringLength, hdfError)
188 0 : CALL h5tset_strpad_f(stringTypeID, H5T_STR_SPACEPAD_F, hdfError)
189 0 : CALL h5tset_cset_f(stringTypeID, H5T_CSET_ASCII_F, hdfError)
190 0 : dims(:1)=(/kpts%numSpecialPoints/)
191 0 : dimsInt=dims
192 0 : CALL h5screate_simple_f(1,dims(:1),kptsSPLabelsSpaceID,hdfError)
193 0 : CALL h5dcreate_f(kptsGroupID, "specialPointLabels", stringTypeID, kptsSPLabelsSpaceID, kptsSPLabelsSetID, hdfError)
194 0 : CALL h5tclose_f(stringTypeID,hdfError)
195 0 : CALL h5sclose_f(kptsSPLabelsSpaceID,hdfError)
196 0 : CALL io_write_string1(kptsSPLabelsSetID,dimsInt(:1),LEN(kpts%specialPointNames(:)),kpts%specialPointNames)
197 0 : CALL h5dclose_f(kptsSPLabelsSetID, hdfError)
198 :
199 0 : dims(:1)=(/kpts%numSpecialPoints/)
200 0 : dimsInt=dims
201 0 : CALL h5screate_simple_f(1,dims(:1),kptsSPIndicesSpaceID,hdfError)
202 0 : CALL h5dcreate_f(kptsGroupID, "specialPointIndices", H5T_NATIVE_INTEGER, kptsSPIndicesSpaceID, kptsSPIndicesSetID, hdfError)
203 0 : CALL h5sclose_f(kptsSPIndicesSpaceID,hdfError)
204 0 : CALL io_write_integer1(kptsSPIndicesSetID,(/1/),dimsInt(:1),"specialPointIndices",kpts%specialPointIndices)
205 0 : CALL h5dclose_f(kptsSPIndicesSetID, hdfError)
206 : END IF
207 :
208 21 : CALL h5gclose_f(kptsGroupID, hdfError)
209 :
210 21 : if (present(vtot)) then
211 : !Write out bxc
212 21 : CALL h5gcreate_f(fileID, '/bxc', bxcGroupID, hdfError)
213 :
214 105 : allocate(bxc_mt(size(vtot%mt,1), 0:size(vtot%mt,2)-1, size(vtot%mt,3)))
215 2099719 : ALLOCATE(bxc_lm(atoms%jmtd,atoms%lmaxd*(atoms%lmaxd+2)+1,atoms%ntype),source=cmplx_0)
216 802736 : bxc_mt = (vtot%mt(:,0:,:,2) - vtot%mt(:,0:,:,1))/2.0
217 47 : do iType = 1, atoms%ntype
218 : !L=0 of potential has an additional rescaling of r/sqrt(4pi)
219 : bxc_mt(:atoms%jri(iType),0,iType) = bxc_mt(:atoms%jri(iType),0,iType) *&
220 21348 : sfp_const/atoms%rmsh(:atoms%jri(iType),iType)
221 47 : CALL lattHarmsRepToSphHarms(sym, atoms, sphhar, iType, bxc_mt(:,0:,iType), bxc_lm(:,:,itype))
222 : enddo
223 :
224 105 : dims(:4)=(/2,atoms%jmtd,atoms%lmaxd*(atoms%lmaxd+2)+1,atoms%ntype/)
225 168 : dimsInt=dims
226 21 : CALL h5screate_simple_f(4,dims(:4),bxcSpaceID,hdfError)
227 21 : CALL h5dcreate_f(bxcGroupID, "data", H5T_NATIVE_DOUBLE, bxcSpaceID, bxcSetID, hdfError)
228 21 : CALL h5sclose_f(bxcSpaceID,hdfError)
229 21 : CALL io_write_complex3(bxcSetID,[-1,1,1,1],dimsInt(:4),"data",bxc_lm)
230 21 : CALL h5dclose_f(bxcSetID, hdfError)
231 :
232 63 : CALL h5gclose_f(bxcGroupID, hdfError)
233 : endif
234 :
235 21 : CALL h5gclose_f(generalGroupID, hdfError)
236 :
237 42 : END SUBROUTINE openGreensFFile
238 :
239 21 : SUBROUTINE closeGreensFFile(fileID)
240 :
241 : INTEGER(HID_T), INTENT(IN) :: fileID
242 :
243 : INTEGER hdfError
244 :
245 21 : CALL h5fclose_f(fileID, hdfError)
246 :
247 21 : END SUBROUTINE closeGreensFFile
248 :
249 21 : SUBROUTINE writeGreensFData(fileID, input, gfinp, atoms, nococonv, noco, cell, archiveType, greensf, mmpmat, selfen,&
250 21 : u, udot, ulo)
251 :
252 : INTEGER(HID_T), INTENT(IN) :: fileID
253 : TYPE(t_input), INTENT(IN) :: input
254 : TYPE(t_gfinp), INTENT(IN) :: gfinp
255 : TYPE(t_atoms), INTENT(IN) :: atoms
256 : TYPE(t_nococonv), INTENT(IN) :: nococonv
257 : TYPE(t_noco), INTENT(IN) :: noco
258 : TYPE(t_cell), INTENT(IN) :: cell
259 : TYPE(t_greensf), INTENT(IN) :: greensf(:)
260 : INTEGER, INTENT(IN) :: archiveType
261 : COMPLEX, INTENT(IN) :: mmpmat(-lmaxU_Const:,-lmaxU_Const:,:,:)
262 :
263 : TYPE(t_selfen), OPTIONAL, INTENT(IN) :: selfen(:) !Only in IO mode for Hubbard 1
264 : REAL, OPTIONAL, INTENT(IN) :: u(:,:,0:,:,:) !Radial Functions for IO
265 : REAL, OPTIONAL, INTENT(IN) :: udot(:,:,0:,:,:)
266 : REAL, OPTIONAL, INTENT(IN) :: ulo(:,:,:,:,:)
267 :
268 : INTEGER(HID_T) :: elementsGroupID,contoursGroupID,radialGroupID
269 : INTEGER(HID_T) :: currentelementGroupID,currentcontourGroupID
270 : INTEGER(HID_T) :: mmpmatSpaceID, mmpmatSetID
271 : INTEGER(HID_T) :: selfenDataSpaceID, selfenDataSetID
272 : INTEGER(HID_T) :: energyPointsSpaceID, energyPointsSetID
273 : INTEGER(HID_T) :: energyWeightsSpaceID, energyWeightsSetID
274 : INTEGER(HID_T) :: uDataSpaceID,uDataSetID
275 : INTEGER(HID_T) :: udotDataSpaceID,udotDataSetID
276 : INTEGER(HID_T) :: uloDataSpaceID,uloDataSetID
277 : INTEGER(HID_T) :: nLODataSpaceID,nLODataSetID
278 : INTEGER(HID_T) :: lLODataSpaceID,lLODataSetID
279 : INTEGER(HID_T) :: DataSpaceID, DataSetID
280 :
281 : CHARACTER(len=30) :: elementName, groupName, shapeStr
282 : INTEGER :: hdfError
283 : INTEGER :: dimsInt(7)
284 : INTEGER :: ispin,m,jspinsOut,iContour
285 : INTEGER :: i_elem,i,iContourOut,nLO
286 21 : INTEGER :: contour_mapping(gfinp%numberContours)
287 : INTEGER(HSIZE_T) :: dims(7)
288 : COMPLEX :: trc(3)
289 : LOGICAL :: l_anyradial
290 21 : TYPE(t_greensf) :: gfOut
291 :
292 :
293 44 : contour_mapping = -1
294 21 : jspinsOut = MERGE(3,input%jspins,gfinp%l_mperp)
295 :
296 : !Check dimensions of mmpmat and selfen
297 21 : IF(SIZE(mmpmat,3) /= SIZE(greensf)) CALL juDFT_error("Mismatch in sizes: mmpmat", calledby="writeGreensFData")
298 21 : IF(PRESENT(selfen)) THEN
299 0 : IF(SIZE(selfen) /= SIZE(greensf)) CALL juDFT_error("Mismatch in sizes: selfen", calledby="writeGreensFData")
300 0 : IF(archiveType /= GREENSF_HUBBARD_CONST) CALL juDFT_error("Wrong archiveType for selfen", calledby="writeGreensFData")
301 : ENDIF
302 :
303 21 : IF(PRESENT(u)) THEN
304 21 : IF(archiveType /= GREENSF_GENERAL_CONST) CALL juDFT_error("Wrong archiveType for u", calledby="writeGreensFData")
305 21 : IF(.NOT.PRESENT(udot)) CALL juDFT_error("udot not provided (u is present)", calledby="writeGreensFData")
306 : ENDIF
307 :
308 : !--> Start: Energy Contour Output
309 21 : CALL h5gcreate_f(fileID, '/EnergyContours', contoursGroupID, hdfError)
310 :
311 21 : iContourOut = 0
312 44 : DO iContour = 1, gfinp%numberContours
313 : !Find a greens function element which has this contour (if not skip)
314 23 : i_elem = -1
315 26 : DO i = 1, SIZE(greensf)
316 26 : IF(iContour == greensf(i)%elem%iContour) THEN
317 23 : i_elem = i
318 23 : EXIT
319 : ENDIF
320 : ENDDO
321 :
322 23 : IF(i_elem==-1) CYCLE
323 :
324 23 : iContourOut = iContourOut + 1
325 23 : WRITE(elementName,100) iContourOut
326 : 100 FORMAT('contour-',i0)
327 23 : contour_mapping(iContour) = iContourOut
328 :
329 23 : CALL h5gcreate_f(contoursGroupID, elementName, currentcontourGroupID, hdfError)
330 :
331 23 : CALL io_write_attint0(currentcontourGroupID,'nz',greensf(i_elem)%contour%nz)
332 :
333 24 : SELECT CASE (gfinp%contour(iContour)%shape)
334 :
335 : CASE(CONTOUR_RECTANGLE_CONST)
336 1 : shapeStr = 'Rectangle'
337 : CASE(CONTOUR_SEMICIRCLE_CONST)
338 21 : shapeStr = 'Semicircle'
339 : CASE(CONTOUR_DOS_CONST)
340 23 : shapeStr = 'DOS'
341 : CASE DEFAULT
342 : END SELECT
343 :
344 23 : CALL io_write_attchar0(currentcontourGroupID,'contourShape',TRIM(ADJUSTL(shapeStr)))
345 23 : CALL io_write_attchar0(currentcontourGroupID,'contourLabel',TRIM(ADJUSTL(gfinp%contour(iContour)%label)))
346 :
347 69 : dims(:2)=[2,greensf(i_elem)%contour%nz]
348 184 : dimsInt=dims
349 23 : CALL h5screate_simple_f(2,dims(:2),energyPointsSpaceID,hdfError)
350 23 : CALL h5dcreate_f(currentcontourGroupID, "ContourPoints", H5T_NATIVE_DOUBLE, energyPointsSpaceID, energyPointsSetID, hdfError)
351 23 : CALL h5sclose_f(energyPointsSpaceID,hdfError)
352 23 : CALL io_write_complex1(energyPointsSetID,[-1,1],dimsInt(:2),"ContourPoints",greensf(i_elem)%contour%e)
353 23 : CALL h5dclose_f(energyPointsSetID, hdfError)
354 69 : dims(:2)=[2,greensf(i_elem)%contour%nz]
355 184 : dimsInt=dims
356 23 : CALL h5screate_simple_f(2,dims(:2),energyWeightsSpaceID,hdfError)
357 23 : CALL h5dcreate_f(currentcontourGroupID, "IntegrationWeights", H5T_NATIVE_DOUBLE, energyWeightsSpaceID, energyWeightsSetID, hdfError)
358 23 : CALL h5sclose_f(energyWeightsSpaceID,hdfError)
359 23 : CALL io_write_complex1(energyWeightsSetID,[-1,1],dimsInt(:2),"IntegrationWeights",greensf(i_elem)%contour%de)
360 23 : CALL h5dclose_f(energyWeightsSetID, hdfError)
361 :
362 136 : CALL h5gclose_f(currentcontourGroupID, hdfError)
363 : ENDDO
364 21 : CALL io_write_attint0(contoursGroupID,'NumContours',iContourOut)
365 21 : CALL h5gclose_f(contoursGroupID, hdfError)
366 : !--> End: Energy Contour Output
367 :
368 :
369 : !--> Start: GF data output
370 42 : SELECT CASE(archiveType)
371 :
372 : CASE(GREENSF_GENERAL_CONST)
373 21 : groupName = '/GreensFunctionElements'
374 : CASE(GREENSF_HUBBARD_CONST)
375 0 : groupName = '/Hubbard1Elements'
376 : CASE DEFAULT
377 21 : CALL juDFT_error("Unknown GF archiveType", calledby="writeGreensFData")
378 : END SELECT
379 :
380 21 : CALL h5gcreate_f(fileID, TRIM(ADJUSTL(groupName)), elementsGroupID, hdfError)
381 21 : CALL io_write_attint0(elementsGroupID,'NumElements',SIZE(greensf))
382 21 : CALL io_write_attint0(elementsGroupID,'maxl',lmaxU_Const)
383 :
384 :
385 21 : l_anyradial = .FALSE.
386 530 : DO i_elem = 1, SIZE(greensf)
387 :
388 509 : WRITE(elementName,200) i_elem
389 : 200 FORMAT('element-',i0)
390 :
391 509 : IF(.NOT.greensf(i_elem)%l_sphavg.AND.gfinp%l_outputSphavg) THEN
392 0 : gfOut = greensf(i_elem)%integrateoverMT(atoms,input,gfinp,u,udot,ulo,l_fullRadial=gfinp%l_intFullRadial)
393 : ELSE
394 509 : gfOut = greensf(i_elem)
395 : ENDIF
396 :
397 509 : CALL h5gcreate_f(elementsGroupID, elementName, currentelementGroupID, hdfError)
398 509 : nLO = greensf(i_elem)%elem%countLOs(atoms)
399 509 : IF(nLO>0 .AND..NOT.gfOut%l_sphavg.AND.PRESENT(u).AND..NOT.PRESENT(ulo)) THEN
400 0 : CALL juDFT_error("LO Radial Functions needed, but not present", calledby="writeGreensFData")
401 : ENDIF
402 509 : IF(.NOT.gfOut%l_sphavg) l_anyradial = .TRUE.
403 :
404 : !Trace of occupation matrix
405 509 : trc=0.0
406 1531 : DO ispin = 1, jspinsOut
407 6653 : DO m = -gfOut%elem%l, gfOut%elem%l
408 6144 : trc(ispin) = trc(ispin) + mmpmat(m,m,i_elem,ispin)
409 : ENDDO
410 : ENDDO
411 509 : CALL io_write_attreal0(currentelementGroupID,"SpinUpTrace",REAL(trc(1)))
412 509 : IF(input%jspins.EQ.2) THEN
413 509 : CALL io_write_attreal0(currentelementGroupID,"SpinDownTrace",REAL(trc(2)))
414 : ENDIF
415 509 : IF(gfinp%l_mperp) THEN
416 4 : CALL io_write_attreal0(currentelementGroupID,"OffDTrace-x",REAL(trc(3)))
417 4 : CALL io_write_attreal0(currentelementGroupID,"OffDTrace-y",AIMAG(trc(3)))
418 : ENDIF
419 :
420 509 : CALL writeGreensFElement(currentelementGroupID, gfOut, atoms, nococonv, noco, cell, jspinsOut, contour_mapping)
421 :
422 : !Occupation matrix
423 2545 : dims(:4)=[2,2*lmaxU_Const+1,2*lmaxU_Const+1,jspinsOut]
424 4072 : dimsInt=dims
425 509 : CALL h5screate_simple_f(4,dims(:4),mmpmatSpaceID,hdfError)
426 509 : CALL h5dcreate_f(currentelementGroupID, "mmpmat", H5T_NATIVE_DOUBLE, mmpmatSpaceID, mmpmatSetID, hdfError)
427 509 : CALL h5sclose_f(mmpmatSpaceID,hdfError)
428 509 : CALL io_write_complex3(mmpmatSetID,[-1,1,1,1],dimsInt(:4),"mmpmat",mmpmat(:,:,i_elem,:jspinsOut))
429 509 : CALL h5dclose_f(mmpmatSetID, hdfError)
430 :
431 509 : IF(archiveType.EQ.GREENSF_HUBBARD_CONST.AND.PRESENT(selfen)) THEN
432 0 : dims(:5)=[2,2*(2*lmaxU_Const+1),2*(2*selfen(i_elem)%l+1),greensf(i_elem)%contour%nz,2]
433 0 : dimsInt=dims
434 0 : CALL h5screate_simple_f(5,dims(:5),selfenDataSpaceID,hdfError)
435 0 : CALL h5dcreate_f(currentelementGroupID, "selfen", H5T_NATIVE_DOUBLE, selfenDataSpaceID, selfenDataSetID, hdfError)
436 0 : CALL h5sclose_f(selfenDataSpaceID,hdfError)
437 0 : CALL io_write_complex4(selfenDataSetID,[-1,1,1,1,1],dimsInt(:5),"selfen",selfen(i_elem)%data)
438 0 : CALL h5dclose_f(selfenDataSetID, hdfError)
439 : ENDIF
440 :
441 2057 : CALL h5gclose_f(currentelementGroupID, hdfError)
442 : ENDDO
443 :
444 21 : CALL h5gclose_f(elementsGroupID, hdfError)
445 : !--> End: GF data output
446 :
447 : !--> Start: Radial Function output
448 21 : IF(PRESENT(u)) THEN
449 21 : CALL h5gcreate_f(fileID, 'RadialFunctions', radialGroupID, hdfError)
450 :
451 63 : dims(:2)=[atoms%jmtd,atoms%ntype]
452 168 : dimsInt=dims
453 21 : CALL h5screate_simple_f(2,dims(:2),DataSpaceID,hdfError)
454 21 : CALL h5dcreate_f(radialGroupID, "rmsh", H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
455 21 : CALL h5sclose_f(DataSpaceID,hdfError)
456 21 : CALL io_write_real2(DataSetID,[1,1],dimsInt(:2),"rmsh",atoms%rmsh)
457 21 : CALL h5dclose_f(DataSetID, hdfError)
458 :
459 42 : dims(:1)=[atoms%ntype]
460 168 : dimsInt=dims
461 21 : CALL h5screate_simple_f(1,dims(:1),DataSpaceID,hdfError)
462 21 : CALL h5dcreate_f(radialGroupID, "jri", H5T_NATIVE_INTEGER, DataSpaceID, DataSetID, hdfError)
463 21 : CALL h5sclose_f(DataSpaceID,hdfError)
464 21 : CALL io_write_integer1(DataSetID,[1],dimsInt(:1),"jri",atoms%jri)
465 21 : CALL h5dclose_f(DataSetID, hdfError)
466 :
467 126 : dims(:5)=[atoms%jmtd,2,lmaxU_Const+1,input%jspins,atoms%ntype]
468 168 : dimsInt=dims
469 21 : CALL h5screate_simple_f(5,dims(:5),uDataSpaceID,hdfError)
470 21 : CALL h5dcreate_f(radialGroupID, "u", H5T_NATIVE_DOUBLE, uDataSpaceID, uDataSetID, hdfError)
471 21 : CALL h5sclose_f(uDataSpaceID,hdfError)
472 21 : CALL io_write_real5(uDataSetID,[1,1,1,1,1],dimsInt(:5),"u",u(:,:,0:lmaxU_Const,:,:))
473 21 : CALL h5dclose_f(uDataSetID, hdfError)
474 :
475 126 : dims(:5)=[atoms%jmtd,2,lmaxU_Const+1,input%jspins,atoms%ntype]
476 168 : dimsInt=dims
477 21 : CALL h5screate_simple_f(5,dims(:5),udotDataSpaceID,hdfError)
478 21 : CALL h5dcreate_f(radialGroupID, "udot", H5T_NATIVE_DOUBLE, udotDataSpaceID, udotDataSetID, hdfError)
479 21 : CALL h5sclose_f(udotDataSpaceID,hdfError)
480 21 : CALL io_write_real5(udotDataSetID,[1,1,1,1,1],dimsInt(:5),"udot",udot(:,:,0:lmaxU_Const,:,:))
481 21 : CALL h5dclose_f(udotDataSetID, hdfError)
482 :
483 21 : IF(PRESENT(ulo)) THEN
484 : !Mapping array
485 42 : dims(:1) = [atoms%ntype]
486 168 : dimsInt=dims
487 21 : CALL h5screate_simple_f(1,dims(:1),nLODataSpaceID,hdfError)
488 21 : CALL h5dcreate_f(radialGroupID, "nlo", H5T_NATIVE_INTEGER, nLODataSpaceID, nLODataSetID, hdfError)
489 21 : CALL h5sclose_f(nLODataSpaceID,hdfError)
490 21 : CALL io_write_integer1(nLODataSetID,[1],dimsInt(:1),"nlo",atoms%nlo)
491 21 : CALL h5dclose_f(nLODataSetID, hdfError)
492 :
493 63 : dims(:2) = [atoms%nlod,atoms%ntype]
494 168 : dimsInt=dims
495 21 : CALL h5screate_simple_f(2,dims(:2),lLODataSpaceID,hdfError)
496 21 : CALL h5dcreate_f(radialGroupID, "llo", H5T_NATIVE_INTEGER, lLODataSpaceID, lLODataSetID, hdfError)
497 21 : CALL h5sclose_f(lLODataSpaceID,hdfError)
498 21 : CALL io_write_integer2(lLODataSetID,[1,1],dimsInt(:2),"llo",atoms%llo)
499 21 : CALL h5dclose_f(lLODataSetID, hdfError)
500 :
501 126 : dims(:5)=[atoms%jmtd,2,atoms%nlod,input%jspins,atoms%ntype]
502 168 : dimsInt=dims
503 21 : CALL h5screate_simple_f(5,dims(:5),uloDataSpaceID,hdfError)
504 21 : CALL h5dcreate_f(radialGroupID, "ulo", H5T_NATIVE_DOUBLE, uloDataSpaceID, uloDataSetID, hdfError)
505 21 : CALL h5sclose_f(uloDataSpaceID,hdfError)
506 21 : CALL io_write_real5(uloDataSetID,[1,1,1,1,1],dimsInt(:5),"ulo",ulo)
507 21 : CALL h5dclose_f(uloDataSetID, hdfError)
508 : ENDIF
509 :
510 21 : CALL h5gclose_f(radialGroupID, hdfError)
511 : ENDIF
512 : !--> End: Radial Function output
513 :
514 :
515 21 : END SUBROUTINE writeGreensFData
516 :
517 509 : SUBROUTINE writeGreensFElement(groupID, g, atoms, nococonv, noco, cell, jspins, contour_mapping)
518 :
519 : INTEGER(HID_T), INTENT(IN) :: groupID
520 : TYPE(t_greensf), INTENT(IN) :: g
521 : TYPE(t_atoms), INTENT(IN) :: atoms
522 : TYPE(t_nococonv), INTENT(IN) :: nococonv
523 : TYPE(t_noco), INTENT(IN) :: noco
524 : TYPE(t_cell), INTENT(IN) :: cell
525 : INTEGER, INTENT(IN) :: jspins
526 : INTEGER, INTENT(IN) :: contour_mapping(:)
527 :
528 :
529 : CHARACTER(len=30) :: groupName, datasetName
530 : INTEGER :: dimsInt(7)
531 : INTEGER(HSIZE_T) :: dims(7)
532 : INTEGER(HID_T) :: DataSpaceID, DataSetID
533 : INTEGER(HID_T) :: loGroupID,currentloGroupID, scalarGroupID
534 : INTEGER :: hdfError,ikpt
535 : INTEGER :: nLO, iLO, iLOp
536 : REAL :: alpha, alphap, beta, betap
537 :
538 509 : alpha=0.0; alphap=0.0
539 509 : beta=0.0; betap=0.0
540 509 : IF(noco%l_noco) THEN
541 6 : alpha = nococonv%alph(g%elem%atomType)
542 6 : alphap = nococonv%alph(g%elem%atomTypep)
543 6 : beta = nococonv%beta(g%elem%atomType)
544 6 : betap = nococonv%beta(g%elem%atomTypep)
545 503 : ELSE IF(noco%l_soc) THEN
546 4 : alpha=nococonv%phi; alphap=nococonv%phi
547 4 : beta=nococonv%theta; betap=nococonv%theta
548 : ENDIF
549 :
550 509 : CALL io_write_attint0(groupID,"l",g%elem%l)
551 509 : CALL io_write_attint0(groupID,"lp",g%elem%lp)
552 509 : CALL io_write_attint0(groupID,"atomType",g%elem%atomType)
553 509 : CALL io_write_attint0(groupID,"atomTypep",g%elem%atomTypep)
554 509 : CALL io_write_attreal0(groupID,"alpha", alpha)
555 509 : CALL io_write_attreal0(groupID,"alphap", alphap)
556 509 : CALL io_write_attreal0(groupID,"beta", beta)
557 509 : CALL io_write_attreal0(groupID,"betap", betap)
558 : !The two attributes below are constant at the moment, but putting them in
559 : !means that the conventions can be changed without disrupting everything outside fleur
560 509 : CALL io_write_attlog0(groupID,"local_spin_frame", .TRUE.)
561 1018 : CALL io_write_attlog0(groupID,"local_real_frame", .NOT.(g%elem%isIntersite().and.noco%l_noco))
562 509 : IF(g%elem%atom/=0) THEN
563 470 : CALL io_write_attchar0(groupID,"atom",TRIM(ADJUSTL(atoms%label(g%elem%atom))))
564 470 : CALL io_write_attchar0(groupID,"atomp",TRIM(ADJUSTL(atoms%label(g%elem%atomp))))
565 : ELSE
566 39 : CALL io_write_attchar0(groupID,"atom",'0')
567 39 : CALL io_write_attchar0(groupID,"atomp",'0')
568 : ENDIF
569 509 : CALL io_write_attint0(groupID,'iContour',contour_mapping(g%elem%iContour))
570 509 : CALL io_write_attlog0(groupID,'l_onsite',.NOT.g%elem%isOffDiag())
571 509 : CALL io_write_attlog0(groupID,'l_sphavg',g%l_sphavg)
572 509 : CALL io_write_attlog0(groupID,'l_kresolved',g%elem%l_kresolved)
573 6617 : CALL io_write_attreal1(groupID,'atomDiff',matmul(cell%amat,g%elem%atomDiff))
574 509 : nLO = g%elem%countLOs(atoms)
575 509 : CALL io_write_attint0(groupID,'numLOs',nLO)
576 :
577 509 : IF(g%l_sphavg.AND..NOT.g%l_kresolved) THEN
578 :
579 3521 : dims(:6)=[2,g%contour%nz,2*lmaxU_Const+1,2*lmaxU_Const+1,jspins,2]
580 4024 : dimsInt=dims
581 503 : CALL h5screate_simple_f(6,dims(:6),DataSpaceID,hdfError)
582 503 : CALL h5dcreate_f(groupID, "sphavg", H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
583 503 : CALL h5sclose_f(DataSpaceID,hdfError)
584 503 : CALL io_write_complex5(DataSetID,[-1,1,1,1,1,1],dimsInt(:6),"gmmpmat",g%gmmpmat)
585 503 : CALL h5dclose_f(DataSetID, hdfError)
586 :
587 6 : ELSE IF(g%l_kresolved) THEN
588 0 : dims(:6)=[2,g%contour%nz,2*lmaxU_Const+1,2*lmaxU_Const+1,jspins,2]
589 0 : dimsInt=dims
590 0 : DO ikpt = 1, SIZE(g%gmmpmat_k,6)
591 0 : WRITE(datasetName,201) ikpt
592 : 201 FORMAT('kresolved-',i0)
593 0 : CALL h5screate_simple_f(6,dims(:6),DataSpaceID,hdfError)
594 0 : CALL h5dcreate_f(groupID, TRIM(ADJUSTL(datasetName)), H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
595 0 : CALL h5sclose_f(DataSpaceID,hdfError)
596 0 : CALL io_write_complex5(DataSetID,[-1,1,1,1,1,1],dimsInt(:6),"gmmpmat_k",g%gmmpmat_k(:,:,:,:,:,ikpt))
597 0 : CALL h5dclose_f(DataSetID, hdfError)
598 : ENDDO
599 : ELSE
600 :
601 : !--> Start: Radial Coefficients
602 42 : dims(:6)=[2,g%contour%nz,2*lmaxU_Const+1,2*lmaxU_Const+1,jspins,2]
603 48 : dimsInt=dims
604 6 : CALL h5screate_simple_f(6,dims(:6),DataSpaceID,hdfError)
605 6 : CALL h5dcreate_f(groupID, "uu", H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
606 6 : CALL h5sclose_f(DataSpaceID,hdfError)
607 6 : CALL io_write_complex5(DataSetID,[-1,1,1,1,1,1],dimsInt(:6),"uu",g%uu)
608 6 : CALL h5dclose_f(DataSetID, hdfError)
609 :
610 42 : dims(:6)=[2,g%contour%nz,2*lmaxU_Const+1,2*lmaxU_Const+1,jspins,2]
611 48 : dimsInt=dims
612 6 : CALL h5screate_simple_f(6,dims(:6),DataSpaceID,hdfError)
613 6 : CALL h5dcreate_f(groupID, "ud", H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
614 6 : CALL h5sclose_f(DataSpaceID,hdfError)
615 6 : CALL io_write_complex5(DataSetID,[-1,1,1,1,1,1],dimsInt(:6),"ud",g%ud)
616 6 : CALL h5dclose_f(DataSetID, hdfError)
617 :
618 42 : dims(:6)=[2,g%contour%nz,2*lmaxU_Const+1,2*lmaxU_Const+1,jspins,2]
619 48 : dimsInt=dims
620 6 : CALL h5screate_simple_f(6,dims(:6),DataSpaceID,hdfError)
621 6 : CALL h5dcreate_f(groupID, "du", H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
622 6 : CALL h5sclose_f(DataSpaceID,hdfError)
623 6 : CALL io_write_complex5(DataSetID,[-1,1,1,1,1,1],dimsInt(:6),"du",g%du)
624 6 : CALL h5dclose_f(DataSetID, hdfError)
625 :
626 42 : dims(:6)=[2,g%contour%nz,2*lmaxU_Const+1,2*lmaxU_Const+1,jspins,2]
627 48 : dimsInt=dims
628 6 : CALL h5screate_simple_f(6,dims(:6),DataSpaceID,hdfError)
629 6 : CALL h5dcreate_f(groupID, "dd", H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
630 6 : CALL h5sclose_f(DataSpaceID,hdfError)
631 6 : CALL io_write_complex5(DataSetID,[-1,1,1,1,1,1],dimsInt(:6),"dd",g%dd)
632 6 : CALL h5dclose_f(DataSetID, hdfError)
633 : !--> End: Radial Coefficients
634 :
635 : !--> Start: LO Coefficients
636 6 : IF(nLO>0) THEN
637 :
638 4 : CALL h5gcreate_f(groupID, 'LOcontribution', loGroupID, hdfError)
639 9 : DO iLO = 1, nLO
640 5 : WRITE(groupName,300) iLO
641 : 300 FORMAT('lo-',i0)
642 5 : CALL h5gcreate_f(loGroupID, groupName, currentloGroupID, hdfError)
643 :
644 35 : dims(:6)=[2,g%contour%nz,2*lmaxU_Const+1,2*lmaxU_Const+1,jspins,2]
645 40 : dimsInt=dims
646 5 : CALL h5screate_simple_f(6,dims(:6),DataSpaceID,hdfError)
647 5 : CALL h5dcreate_f(currentloGroupID, "uulo", H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
648 5 : CALL h5sclose_f(DataSpaceID,hdfError)
649 5 : CALL io_write_complex5(DataSetID,[-1,1,1,1,1,1],dimsInt(:6),"uulo",g%uulo(:,:,:,iLO,:,:))
650 5 : CALL h5dclose_f(DataSetID, hdfError)
651 :
652 35 : dims(:6)=[2,g%contour%nz,2*lmaxU_Const+1,2*lmaxU_Const+1,jspins,2]
653 40 : dimsInt=dims
654 5 : CALL h5screate_simple_f(6,dims(:6),DataSpaceID,hdfError)
655 5 : CALL h5dcreate_f(currentloGroupID, "ulou", H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
656 5 : CALL h5sclose_f(DataSpaceID,hdfError)
657 5 : CALL io_write_complex5(DataSetID,[-1,1,1,1,1,1],dimsInt(:6),"ulou",g%ulou(:,:,:,iLO,:,:))
658 5 : CALL h5dclose_f(DataSetID, hdfError)
659 :
660 35 : dims(:6)=[2,g%contour%nz,2*lmaxU_Const+1,2*lmaxU_Const+1,jspins,2]
661 40 : dimsInt=dims
662 5 : CALL h5screate_simple_f(6,dims(:6),DataSpaceID,hdfError)
663 5 : CALL h5dcreate_f(currentloGroupID, "dulo", H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
664 5 : CALL h5sclose_f(DataSpaceID,hdfError)
665 5 : CALL io_write_complex5(DataSetID,[-1,1,1,1,1,1],dimsInt(:6),"dulo",g%dulo(:,:,:,iLO,:,:))
666 5 : CALL h5dclose_f(DataSetID, hdfError)
667 :
668 35 : dims(:6)=[2,g%contour%nz,2*lmaxU_Const+1,2*lmaxU_Const+1,jspins,2]
669 40 : dimsInt=dims
670 5 : CALL h5screate_simple_f(6,dims(:6),DataSpaceID,hdfError)
671 5 : CALL h5dcreate_f(currentloGroupID, "ulod", H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
672 5 : CALL h5sclose_f(DataSpaceID,hdfError)
673 5 : CALL io_write_complex5(DataSetID,[-1,1,1,1,1,1],dimsInt(:6),"ulod",g%ulod(:,:,:,iLO,:,:))
674 5 : CALL h5dclose_f(DataSetID, hdfError)
675 :
676 :
677 12 : DO iLop = 1, nLO
678 7 : WRITE(datasetName,400) iLop
679 : 400 FORMAT('uloulop-',i0)
680 :
681 49 : dims(:6)=[2,g%contour%nz,2*lmaxU_Const+1,2*lmaxU_Const+1,jspins,2]
682 56 : dimsInt=dims
683 7 : CALL h5screate_simple_f(6,dims(:6),DataSpaceID,hdfError)
684 7 : CALL h5dcreate_f(currentloGroupID, TRIM(ADJUSTL(datasetName)), H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
685 7 : CALL h5sclose_f(DataSpaceID,hdfError)
686 7 : CALL io_write_complex5(DataSetID,[-1,1,1,1,1,1],dimsInt(:6),"uloulop",g%uloulop(:,:,:,iLO,iLOp,:,:))
687 19 : CALL h5dclose_f(DataSetID, hdfError)
688 : ENDDO
689 54 : CALL h5gclose_f(currentloGroupID, hdfError)
690 :
691 : ENDDO
692 4 : CALL h5gclose_f(loGroupID, hdfError)
693 : !--> End: LO Coefficients
694 : ENDIF
695 :
696 : !--> Start: Scalar Products
697 6 : CALL h5gcreate_f(groupID, 'scalarProducts', scalarGroupID, hdfError)
698 :
699 18 : dims(:2)=[2,2]
700 48 : dimsInt=dims
701 6 : CALL h5screate_simple_f(2,dims(:2),DataSpaceID,hdfError)
702 6 : CALL h5dcreate_f(scalarGroupID, "uun", H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
703 6 : CALL h5sclose_f(DataSpaceID,hdfError)
704 6 : CALL io_write_real2(DataSetID,[1,1],dimsInt(:2),"uun",g%scalarProducts%uun)
705 6 : CALL h5dclose_f(DataSetID, hdfError)
706 :
707 18 : dims(:2)=[2,2]
708 48 : dimsInt=dims
709 6 : CALL h5screate_simple_f(2,dims(:2),DataSpaceID,hdfError)
710 6 : CALL h5dcreate_f(scalarGroupID, "dun", H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
711 6 : CALL h5sclose_f(DataSpaceID,hdfError)
712 6 : CALL io_write_real2(DataSetID,[1,1],dimsInt(:2),"dun",g%scalarProducts%dun)
713 6 : CALL h5dclose_f(DataSetID, hdfError)
714 :
715 18 : dims(:2)=[2,2]
716 48 : dimsInt=dims
717 6 : CALL h5screate_simple_f(2,dims(:2),DataSpaceID,hdfError)
718 6 : CALL h5dcreate_f(scalarGroupID, "udn", H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
719 6 : CALL h5sclose_f(DataSpaceID,hdfError)
720 6 : CALL io_write_real2(DataSetID,[1,1],dimsInt(:2),"udn",g%scalarProducts%udn)
721 6 : CALL h5dclose_f(DataSetID, hdfError)
722 :
723 18 : dims(:2)=[2,2]
724 48 : dimsInt=dims
725 6 : CALL h5screate_simple_f(2,dims(:2),DataSpaceID,hdfError)
726 6 : CALL h5dcreate_f(scalarGroupID, "ddn", H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
727 6 : CALL h5sclose_f(DataSpaceID,hdfError)
728 6 : CALL io_write_real2(DataSetID,[1,1],dimsInt(:2),"ddn",g%scalarProducts%ddn)
729 6 : CALL h5dclose_f(DataSetID, hdfError)
730 :
731 24 : dims(:3)=[atoms%nlod,2,2]
732 48 : dimsInt=dims
733 6 : CALL h5screate_simple_f(3,dims(:3),DataSpaceID,hdfError)
734 6 : CALL h5dcreate_f(scalarGroupID, "uulon", H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
735 6 : CALL h5sclose_f(DataSpaceID,hdfError)
736 6 : CALL io_write_real3(DataSetID,[1,1,1],dimsInt(:3),"uulon",g%scalarProducts%uulon)
737 6 : CALL h5dclose_f(DataSetID, hdfError)
738 :
739 24 : dims(:3)=[atoms%nlod,2,2]
740 48 : dimsInt=dims
741 6 : CALL h5screate_simple_f(3,dims(:3),DataSpaceID,hdfError)
742 6 : CALL h5dcreate_f(scalarGroupID, "uloun", H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
743 6 : CALL h5sclose_f(DataSpaceID,hdfError)
744 6 : CALL io_write_real3(DataSetID,[1,1,1],dimsInt(:3),"uloun",g%scalarProducts%uloun)
745 6 : CALL h5dclose_f(DataSetID, hdfError)
746 :
747 24 : dims(:3)=[atoms%nlod,2,2]
748 48 : dimsInt=dims
749 6 : CALL h5screate_simple_f(3,dims(:3),DataSpaceID,hdfError)
750 6 : CALL h5dcreate_f(scalarGroupID, "dulon", H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
751 6 : CALL h5sclose_f(DataSpaceID,hdfError)
752 6 : CALL io_write_real3(DataSetID,[1,1,1],dimsInt(:3),"dulon",g%scalarProducts%dulon)
753 6 : CALL h5dclose_f(DataSetID, hdfError)
754 :
755 24 : dims(:3)=[atoms%nlod,2,2]
756 48 : dimsInt=dims
757 6 : CALL h5screate_simple_f(3,dims(:3),DataSpaceID,hdfError)
758 6 : CALL h5dcreate_f(scalarGroupID, "ulodn", H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
759 6 : CALL h5sclose_f(DataSpaceID,hdfError)
760 6 : CALL io_write_real3(DataSetID,[1,1,1],dimsInt(:3),"ulodn",g%scalarProducts%ulodn)
761 6 : CALL h5dclose_f(DataSetID, hdfError)
762 :
763 30 : dims(:4)=[atoms%nlod,atoms%nlod,2,2]
764 48 : dimsInt=dims
765 6 : CALL h5screate_simple_f(4,dims(:4),DataSpaceID,hdfError)
766 6 : CALL h5dcreate_f(scalarGroupID, "uloulopn", H5T_NATIVE_DOUBLE, DataSpaceID, DataSetID, hdfError)
767 6 : CALL h5sclose_f(DataSpaceID,hdfError)
768 6 : CALL io_write_real4(DataSetID,[1,1,1,1],dimsInt(:4),"uloulopn",g%scalarProducts%uloulopn)
769 6 : CALL h5dclose_f(DataSetID, hdfError)
770 :
771 6 : CALL h5gclose_f(scalarGroupID, hdfError)
772 : !--> End: Scalar Products
773 :
774 : ENDIF
775 :
776 509 : END SUBROUTINE writeGreensFElement
777 :
778 0 : SUBROUTINE io_write_string1(datasetID,dims,stringLength,dataArray)
779 :
780 : USE hdf5
781 : USE m_hdf_tools4
782 :
783 : IMPLICIT NONE
784 :
785 : INTEGER(HID_T), INTENT(IN) :: datasetID
786 : INTEGER, INTENT(IN) :: dims(1)
787 : INTEGER, INTENT(IN) :: stringLength
788 : CHARACTER(LEN=stringLength), INTENT(IN) :: dataArray(:)
789 :
790 : INTEGER :: hdfError
791 : INTEGER(HID_T) :: dataspaceID, memSpaceID
792 : INTEGER(HID_T) :: stringTypeID
793 : INTEGER(HID_t) :: trans
794 : INTEGER(HSIZE_t) :: memOffset(1), fncount(1)
795 : INTEGER(HSIZE_t) :: dimsHDF(1)
796 : INTEGER(SIZE_T) :: stringLengthHDF
797 :
798 0 : stringLengthHDF = stringLength
799 0 : dimsHDF(:) = dims(:)
800 0 : memOffset(:) = 0
801 0 : fnCount(:) = dims(:)
802 :
803 0 : trans = gettransprop()
804 :
805 0 : CALL h5tcopy_f(H5T_NATIVE_CHARACTER, stringTypeID, hdfError)
806 0 : CALL h5tset_size_f(stringTypeID, stringLengthHDF, hdfError)
807 0 : CALL h5tset_strpad_f(stringTypeID, H5T_STR_SPACEPAD_F, hdfError)
808 0 : CALL h5tset_cset_f(stringTypeID, H5T_CSET_ASCII_F, hdfError)
809 :
810 0 : CALL h5dget_space_f(datasetID,dataspaceID,hdfError)
811 0 : CALL h5sselect_hyperslab_f(dataspaceID,H5S_SELECT_SET_F,memOffset,fncount,hdfError)
812 0 : CALL h5screate_simple_f(1,dimsHDF,memSpaceID,hdfError)
813 0 : CALL h5dwrite_f(datasetID,stringTypeID,dataArray,dimsHDF,hdfError,memSpaceID,dataspaceID,trans)
814 0 : CALL h5sclose_f(memSpaceID,hdfError)
815 0 : CALL h5sclose_f(dataspaceID,hdfError)
816 0 : CALL cleartransprop(trans)
817 :
818 0 : CALL h5tclose_f(stringTypeID,hdfError)
819 :
820 0 : CALL io_check("io_write_string1 !",hdfError)
821 :
822 0 : END SUBROUTINE io_write_string1
823 :
824 : #endif
825 :
826 : END MODULE m_greensf_io
|
