Siesta

Merge lp:~nickpapior/siesta/4.1-fdf-blocks into lp:siesta/4.1

  1. 4.1-fdf-blocks
  2. Merge into rel-4.1
Proposed by Nick Papior
Status: Merged
Approved by: Alberto Garcia
Approved revision: 984
Merged at revision: 986
Proposed branch: lp:~nickpapior/siesta/4.1-fdf-blocks
Merge into: lp:siesta/4.1
Diff against target: 770 lines (+112/-109)
31 files modified
Src/Makefile (+4/-4)
Src/broyden_optim.F (+2/-0)
Src/cell_broyden_optim.F (+2/-0)
Src/cgvc.F (+2/-0)
Src/cgvc_zmatrix.F (+2/-0)
Src/chemical.f (+5/-13)
Src/coor.F (+5/-9)
Src/fdf_extra.F90 (+19/-19)
Src/get_target_stress.f (+2/-0)
Src/kgrid.F (+1/-1)
Src/kgridinit.F (+2/-1)
Src/kpoint_grid.F90 (+1/-0)
Src/kpoint_pdos.F90 (+2/-1)
Src/ksvinit.F (+1/-1)
Src/ldau_specs.f (+1/-1)
Src/local_DOS.F (+1/-0)
Src/m_efield.F (+3/-6)
Src/m_new_dm.F90 (+1/-1)
Src/m_spin.F90 (+4/-1)
Src/m_target_stress.F (+2/-0)
Src/m_ts_io_ctype.f90 (+11/-26)
Src/m_ts_kpoints.F90 (+1/-0)
Src/meshsubs.F (+1/-0)
Src/metaforce.F (+24/-17)
Src/projected_DOS.F (+3/-4)
Src/read_xc_info.F (+1/-0)
Src/readsp.F (+1/-0)
Src/redcel.F (+4/-2)
Src/reoptical.F (+1/-0)
Src/zm_broyden_optim.F (+2/-1)
version.info (+1/-1)
To merge this branch: bzr merge lp:~nickpapior/siesta/4.1-fdf-blocks
Reviewer Review Type Date Requested Status
Alberto Garcia Approve
Review via email: mp+354532@code.launchpad.net

Commit message

Implemented closing of the majority of commonly used blocks

Closing of blocks in the log when using fdf_b* calls was problematic
if the code did not read the last line of the block (i.e. this was
the only way to ensure the %endblock <label> in the fdf-*.log.

There are some problems with this and transiesta because the transiesta
codes are using fdf_bbackspace (which re-writes to the log file).
However, for Siesta the above should work.%

Description of the change

Since this change touches some core places I think it is better if you had a glance at it.

I have tested a few tests and it now writes out the %endblock in the log file.

It does, however, have some problems when using the fdf_bbackspace methods.

To post a comment you must log in.
Revision history for this message
Alberto Garcia (albertog) wrote :

Approved.

review: Approve

Preview Diff

[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
1=== modified file 'Src/Makefile'
2--- Src/Makefile 2018-09-04 11:56:15 +0000
3+++ Src/Makefile 2018-09-09 19:50:11 +0000
4@@ -865,7 +865,7 @@
5 m_ncdf_io.o: class_Sparsity.o m_io_s.o parallel.o precision.o
6 m_ncdf_siesta.o: atm_types.o atmparams.o atomlist.o class_Sparsity.o files.o
7 m_ncdf_siesta.o: kpoint_grid.o m_energies.o m_forces.o m_kinetic.o m_ncdf_io.o
8-m_ncdf_siesta.o: m_ntm.o m_spin.o m_stress.o m_ts_electype.o m_ts_kpoints.o
9+m_ncdf_siesta.o: m_spin.o m_stress.o m_ts_electype.o m_ts_kpoints.o
10 m_ncdf_siesta.o: m_ts_options.o parallel.o precision.o radial.o siesta_geom.o
11 m_ncdf_siesta.o: siesta_options.o sparse_matrices.o timestamp.o
12 m_new_dm.o: alloc.o atomlist.o class_Data2D.o class_Fstack_Data1D.o
13@@ -1238,9 +1238,9 @@
14 siesta_analysis.o: write_subs.o writewave.o zmatrix.o
15 siesta_cmlsubs.o: files.o m_uuid.o parallel.o siesta_cml.o timestamp.o
16 siesta_cmlsubs.o:
17-siesta_dicts.o: atomlist.o files.o kpoint_grid.o m_energies.o m_forces.o
18-siesta_dicts.o: m_mixing_scf.o m_steps.o m_stress.o precision.o siesta_geom.o
19-siesta_dicts.o: siesta_options.o
20+siesta_dicts.o: atomlist.o class_SpData1D.o files.o kpoint_grid.o m_energies.o
21+siesta_dicts.o: m_forces.o m_mixing_scf.o m_steps.o m_stress.o precision.o
22+siesta_dicts.o: siesta_geom.o siesta_options.o sparse_matrices.o
23 siesta_end.o: alloc.o bands.o densematrix.o diag.o extrae_eventllist.o
24 siesta_end.o: flook_siesta.o m_dscfcomm.o m_fixed.o m_io.o m_mixing_scf.o
25 siesta_end.o: m_rhog.o m_wallclock.o meshdscf.o meshphi.o moremeshsubs.o
26
27=== modified file 'Src/broyden_optim.F'
28--- Src/broyden_optim.F 2016-01-25 16:00:16 +0000
29+++ Src/broyden_optim.F 2018-09-09 19:50:11 +0000
30@@ -187,6 +187,8 @@
31 sxy = fdf_bvalues(pline,4)
32 sxz = fdf_bvalues(pline,5)
33 syz = fdf_bvalues(pline,6)
34+ call fdf_bclose(bfdf)
35+
36 tstres(1,1) = - sxx * tp
37 tstres(2,2) = - syy * tp
38 tstres(3,3) = - szz * tp
39
40=== modified file 'Src/cell_broyden_optim.F'
41--- Src/cell_broyden_optim.F 2016-01-25 16:00:16 +0000
42+++ Src/cell_broyden_optim.F 2018-09-09 19:50:11 +0000
43@@ -180,6 +180,8 @@
44 sxy = fdf_bvalues(pline,4)
45 sxz = fdf_bvalues(pline,5)
46 syz = fdf_bvalues(pline,6)
47+ call fdf_bclose(bfdf)
48+
49 target_stress(1,1) = - sxx * tp
50 target_stress(2,2) = - syy * tp
51 target_stress(3,3) = - szz * tp
52
53=== modified file 'Src/cgvc.F'
54--- Src/cgvc.F 2016-01-25 16:00:16 +0000
55+++ Src/cgvc.F 2018-09-09 19:50:11 +0000
56@@ -145,6 +145,8 @@
57 sxy = fdf_bvalues(pline,4)
58 sxz = fdf_bvalues(pline,5)
59 syz = fdf_bvalues(pline,6)
60+ call fdf_bclose(bfdf)
61+
62 tstres(1,1) = - sxx * tp
63 tstres(2,2) = - syy * tp
64 tstres(3,3) = - szz * tp
65
66=== modified file 'Src/cgvc_zmatrix.F'
67--- Src/cgvc_zmatrix.F 2016-01-25 16:00:16 +0000
68+++ Src/cgvc_zmatrix.F 2018-09-09 19:50:11 +0000
69@@ -141,6 +141,8 @@
70 sxy = fdf_bvalues(pline,4)
71 sxz = fdf_bvalues(pline,5)
72 syz = fdf_bvalues(pline,6)
73+ call fdf_bclose(bfdf)
74+
75 tstres(1,1) = - sxx * tp
76 tstres(2,2) = - syy * tp
77 tstres(3,3) = - szz * tp
78
79=== modified file 'Src/chemical.f'
80--- Src/chemical.f 2017-01-25 10:42:39 +0000
81+++ Src/chemical.f 2018-09-09 19:50:11 +0000
82@@ -115,22 +115,17 @@
83 if ( present(silent) ) lsilent = silent
84 if ( Node /= 0 ) lsilent = .true.
85
86+ ! Default to 0
87+ nsp = fdf_integer('Number_of_species',0)
88+
89 ! The most important thing to find is
90 ! the block containing the species
91- found = fdf_block('Chemical_species_label',bfdf)
92+ found = fdf_block('Chemical_species_label', bfdf)
93 if (.not. found )
94 $ call die("Block Chemical_species_label does not exist.")
95
96- ! Default to 0
97- nsp = fdf_integer('Number_of_species',0)
98 if ( nsp == 0 ) then
99- ! try and guess the number of species
100- ns_read = 0
101- do while( fdf_bline(bfdf,pline) )
102- if ( fdf_bmatch(pline,'iin') ) then
103- ns_read = ns_read + 1
104- end if
105- end do
106+ ns_read = fdf_block_linecount('Chemical_species_label', 'iin')
107 else
108 ns_read = nsp
109 end if
110@@ -144,9 +139,6 @@
111 allocate(chemical_list%z(nsp))
112 chemical_list%no_of_species = nsp
113
114- ! Rewind the block
115- call fdf_brewind(bfdf)
116-
117 ns_read = 0
118 do while( fdf_bline(bfdf,pline) )
119 if ( .not. fdf_bmatch(pline,'iin') ) cycle
120
121=== modified file 'Src/coor.F'
122--- Src/coor.F 2016-09-14 10:57:36 +0000
123+++ Src/coor.F 2018-09-09 19:50:11 +0000
124@@ -138,13 +138,8 @@
125 if ( na == 0 ) then
126 ! estimate the number of atoms by reading the block
127 ! Currently we do not try to estimate from a Z-matrix
128- if (fdf_block('AtomicCoordinatesAndAtomicSpecies',bfdf)) then
129- na = 0
130- do while ( fdf_bline(bfdf,pline) )
131- ! each line should contain one atom
132- na = na + 1
133- end do
134- end if
135+ na = fdf_block_linecount('AtomicCoordinatesAndAtomicSpecies',
136+ & 'vvvi')
137 end if
138 if ( na == 0 ) then
139 call die("Must specify number of atoms AND coordinates!")
140@@ -170,6 +165,7 @@
141 origin(1) = fdf_bvalues(pline,1)
142 origin(2) = fdf_bvalues(pline,2)
143 origin(3) = fdf_bvalues(pline,3)
144+ call fdf_bclose(bfdf)
145 else
146 origin = 0._dp
147 endif
148@@ -195,7 +191,7 @@
149 else
150
151 C If Z matrix hasn't been found, read regular atomic coordinates
152- if (fdf_block('AtomicCoordinatesAndAtomicSpecies',bfdf)) then
153+ if ( fdf_block('AtomicCoordinatesAndAtomicSpecies',bfdf) ) then
154 do ia= 1, nua
155 if (.not. fdf_bline(bfdf,pline))
156 . call die('coor: ERROR in ' //
157@@ -209,7 +205,7 @@
158 endif
159
160 enddo
161-
162+ call fdf_bclose(bfdf)
163 else
164 call die("coor: You must specify the atomic coordinates")
165 endif
166
167=== modified file 'Src/fdf_extra.F90'
168--- Src/fdf_extra.F90 2018-07-30 10:26:25 +0000
169+++ Src/fdf_extra.F90 2018-09-09 19:50:11 +0000
170@@ -73,13 +73,13 @@
171 call fdf_blists(pline,il,i1,list(n+1:))
172 if ( i1 + n > size(list) ) then
173 print *,'Parsed line: ',trim(pline%line)
174- call die('fdf_extra: number of elements in block list &
175+ call die('fdf_brange: number of elements in block list &
176 &is too many to fit the maximal range of the &
177 &list. Please correct.')
178 end if
179 if ( i1 == 0 ) then
180 print *,'Parsed line: ',trim(pline%line)
181- call die('fdf_extra: a block list with zero elements is not &
182+ call die('fdf_brange: a block list with zero elements is not &
183 &allowed, please correct input.')
184 end if
185
186@@ -102,14 +102,14 @@
187 g = fdf_bnames(pline,2)
188 if ( .not. leqi(g,'from') ) then
189 print *,'Parsed line: ',trim(pline%line)
190- call die('fdf_extra: error in range block: &
191+ call die('fdf_brange: error in range block: &
192 &from <int> to/plus/minus <int> is ill formatted')
193 end if
194
195 g = fdf_bnames(pline,3)
196 if ( fdf_bnintegers(pline) < 2 ) then
197 print *,'Parsed line: ',trim(pline%line)
198- call die('fdf_extra: error in range block &
199+ call die('fdf_brange: error in range block &
200 &from <int> to/plus/minus <int> is ill formatted')
201 end if
202
203@@ -135,7 +135,7 @@
204 i2 = i1 - i2 + 1
205 else
206 print *,'Parsed line: ',trim(pline%line)
207- call die('fdf_extra: unrecognized designator of ending range, &
208+ call die('fdf_brange: unrecognized designator of ending range, &
209 &[to, plus, minus] accepted.')
210 end if
211
212@@ -153,7 +153,7 @@
213 (i1 > i2 .and. step > 0) ) then
214 print *,'Parsed line: ',trim(pline%line)
215 print *,i1,i2,step
216- call die('fdf_extra: block range is not consecutive')
217+ call die('fdf_brange: block range is not consecutive')
218 end if
219
220 ! Create list
221@@ -166,14 +166,14 @@
222 else
223
224 print *,'Parsed line: ',trim(pline%line)
225- call die('fdf_extra: error in range block, input not recognized')
226+ call die('fdf_brange: error in range block, input not recognized')
227
228 end if
229
230 do j = 1 , n
231 if ( list(j) < low .or. high < list(j) ) then
232 print *,'Parsed line: ',trim(pline%line)
233- call die('fdf_extra: error in range block. Input is beyond range')
234+ call die('fdf_brange: error in range block. Input is beyond range')
235 end if
236 end do
237
238@@ -240,16 +240,16 @@
239 n_r = 0
240 if ( allocated(rgns) ) deallocate(rgns)
241
242- ! If the block does not exist, simply return
243- if ( .not. fdf_block(bName,bfdf) ) return
244-
245- ! the initial number of regions
246- il = 0
247- do while ( fdf_bnext(bfdf,pline) )
248- il = il + 1
249- end do
250+ ! Get number of regions
251+ il = fdf_block_linecount(bName)
252+ if ( il == 0 ) return
253+
254+ if ( .not. fdf_block(bName,bfdf) ) then
255+ call die('fdf_bregions: failed implementation.')
256+ end if
257+
258+ ! allocate
259 allocate(rlist(il))
260- call fdf_brewind(bfdf)
261
262 ! first count number of differently named regions
263 do while ( fdf_bnext(bfdf,pline) )
264@@ -302,7 +302,7 @@
265 call fdf_brange(pline,r1,1,n)
266 if ( r1%n == 0 ) then
267 print *,'Region: ',trim(g)
268- call die('fdf_extra: Could not read in anything in region!')
269+ call die('fdf_bregions: Could not read in anything in region!')
270 end if
271 call rgn_union(rgns(il),r1,rgns(il))
272 rgns(il)%name = trim(g)
273@@ -312,7 +312,7 @@
274 call fdf_brange(pline,r1,1,n)
275 if ( r1%n == 0 ) then
276 print *,'Region: ',trim(g)
277- call die('fdf_extra: Could not read in anything in region!')
278+ call die('fdf_bregions: Could not read in anything in region!')
279 end if
280 call rgn_union(rgns(ic),r1,rgns(ic))
281 rgns(ic)%name = trim(g)
282
283=== modified file 'Src/get_target_stress.f'
284--- Src/get_target_stress.f 2016-01-25 16:00:16 +0000
285+++ Src/get_target_stress.f 2018-09-09 19:50:11 +0000
286@@ -42,6 +42,8 @@
287 sxy = fdf_bvalues(pline,4)
288 sxz = fdf_bvalues(pline,5)
289 syz = fdf_bvalues(pline,6)
290+ call fdf_bclose(bfdf)
291+
292 tstres(1,1) = - sxx * tp
293 tstres(2,2) = - syy * tp
294 tstres(3,3) = - szz * tp
295
296=== modified file 'Src/kgrid.F'
297--- Src/kgrid.F 2016-01-25 16:00:16 +0000
298+++ Src/kgrid.F 2018-09-09 19:50:11 +0000
299@@ -63,7 +63,7 @@
300 parameter (tiny = 1.d-12)
301
302 C Find out if there is spiral arrangement of spins
303- spiral = fdf_block('SpinSpiral',bfdf)
304+ spiral = fdf_isblock('SpinSpiral')
305
306 C Find total number of points (determinant of kscell)
307 nktot = abs( kscell(1,1) * kscell(2,2) * kscell(3,3) +
308
309=== modified file 'Src/kgridinit.F'
310--- Src/kgridinit.F 2017-10-10 19:47:15 +0000
311+++ Src/kgridinit.F 2018-09-09 19:50:11 +0000
312@@ -92,7 +92,7 @@
313
314 genlogic = .false.
315 C Find out if there is spiral arrangement of spins
316- spiral = fdf_block('SpinSpiral',bfdf)
317+ spiral = fdf_isblock('SpinSpiral')
318
319 C Find total number of points (determinant of kscell)
320 nktot = abs( kscell(1,1) * kscell(2,2) * kscell(3,3) +
321@@ -118,6 +118,7 @@
322 displ(i) = 0._dp
323 end if
324 enddo
325+ call fdf_bclose(bfdf)
326 nktot = abs( kscell(1,1) * kscell(2,2) * kscell(3,3) +
327 . kscell(2,1) * kscell(3,2) * kscell(1,3) +
328 . kscell(3,1) * kscell(1,2) * kscell(2,3) -
329
330=== modified file 'Src/kpoint_grid.F90'
331--- Src/kpoint_grid.F90 2018-04-14 23:14:53 +0000
332+++ Src/kpoint_grid.F90 2018-09-09 19:50:11 +0000
333@@ -145,6 +145,7 @@
334 kdispl(i) = 0._dp
335 end if
336 enddo
337+ call fdf_bclose(bfdf)
338 firm_displ = .true.
339
340 else
341
342=== modified file 'Src/kpoint_pdos.F90'
343--- Src/kpoint_pdos.F90 2018-04-14 23:14:53 +0000
344+++ Src/kpoint_pdos.F90 2018-09-09 19:50:11 +0000
345@@ -159,7 +159,8 @@
346 else
347 kdispl(i) = 0._dp
348 end if
349- enddo
350+ enddo
351+ call fdf_bclose(bfdf)
352 firm_displ = .true.
353
354 else
355
356=== modified file 'Src/ksvinit.F'
357--- Src/ksvinit.F 2016-01-25 16:00:16 +0000
358+++ Src/ksvinit.F 2018-09-09 19:50:11 +0000
359@@ -229,7 +229,7 @@
360 endif
361
362 enddo
363-
364+ call fdf_bclose(bfdf)
365 endif
366
367 end subroutine repol
368
369=== modified file 'Src/ldau_specs.f'
370--- Src/ldau_specs.f 2016-11-25 18:04:25 +0000
371+++ Src/ldau_specs.f 2018-09-09 19:50:11 +0000
372@@ -428,7 +428,7 @@
373 nprojsldau(:) = 0
374
375 ! Read the LDAU.proj block
376- if (.not. fdf_block('LDAU.proj',bfdf)) RETURN
377+ if (.not. fdf_block('LDAU.proj', bfdf)) RETURN
378
379 ! Add citation
380 if ( IONode ) then
381
382=== modified file 'Src/local_DOS.F'
383--- Src/local_DOS.F 2018-06-25 11:33:42 +0000
384+++ Src/local_DOS.F 2018-09-09 19:50:11 +0000
385@@ -70,6 +70,7 @@
386 factor = fdf_convfac( fdf_bnames(pline,1), 'Ry' )
387 e1 = fdf_bvalues(pline,1)*factor
388 e2 = fdf_bvalues(pline,2)*factor
389+ call fdf_bclose(bfdf)
390
391 !Find the density matrix for states between e1 and e2
392 if ((isolve .eq. SOLVE_DIAGON) .or.
393
394=== modified file 'Src/m_efield.F'
395--- Src/m_efield.F 2018-01-26 13:17:30 +0000
396+++ Src/m_efield.F 2018-09-09 19:50:11 +0000
397@@ -52,7 +52,6 @@
398
399 real(dp), intent(out) :: input_field(3)
400
401- logical :: found
402 type(block_fdf) :: bfdf
403 type(parsed_line), pointer :: pline => null()
404
405@@ -63,10 +62,8 @@
406
407 input_field(1:3) = 0.0_dp
408
409- found = fdf_block('ExternalElectricField',bfdf)
410- if (.not. found ) RETURN
411- loop: DO
412- if (.not. fdf_bline(bfdf,pline)) exit loop
413+ if (.not. fdf_block('ExternalElectricField',bfdf) ) RETURN
414+ do while ( fdf_bline(bfdf,pline) )
415 if (.not. fdf_bmatch(pline,"vvvn"))
416 $ call die("Wrong format in ElectricField block")
417 eunits = fdf_bnames(pline,1)
418@@ -74,7 +71,7 @@
419 do ix = 1,3
420 input_field(ix) = fdf_bvalues(pline,ix) * cfactor
421 enddo
422- enddo loop
423+ enddo
424
425 end subroutine get_user_specified_field
426 !----------------------------------------------------------------
427
428=== modified file 'Src/m_new_dm.F90'
429--- Src/m_new_dm.F90 2018-06-28 13:53:17 +0000
430+++ Src/m_new_dm.F90 2018-09-09 19:50:11 +0000
431@@ -981,7 +981,7 @@
432
433 ! Read the data from the block and then we populate DM
434 na = 0
435- do while( fdf_bline(bfdf,pline) .and. na < na_u )
436+ do while( fdf_bline(bfdf,pline) )
437
438 ! Read number of names, integers and reals on this line
439 ni = fdf_bnintegers(pline)
440
441=== modified file 'Src/m_spin.F90'
442--- Src/m_spin.F90 2018-02-27 14:03:49 +0000
443+++ Src/m_spin.F90 2018-09-09 19:50:11 +0000
444@@ -338,7 +338,7 @@
445 subroutine init_spiral( ucell )
446 use fdf, only : fdf_get, leqi
447 use fdf, only: block_fdf, parsed_line
448- use fdf, only: fdf_block, fdf_bline
449+ use fdf, only: fdf_block, fdf_bline, fdf_bclose
450 use fdf, only: fdf_bnames, fdf_bvalues
451 use units, only: Pi
452
453@@ -381,6 +381,9 @@
454 call die('init_spiral: ERROR: ReciprocalCoordinates must be' // &
455 ' ''Cubic'' or ''ReciprocalLatticeVectors''')
456 end if
457+
458+ call fdf_bclose(bfdf)
459+
460 end subroutine init_spiral
461
462 function fname_spin(nspin,ispin,slabel,suffix,basename) result(fname)
463
464=== modified file 'Src/m_target_stress.F'
465--- Src/m_target_stress.F 2016-10-31 21:00:50 +0000
466+++ Src/m_target_stress.F 2018-09-09 19:50:11 +0000
467@@ -73,6 +73,8 @@
468 sxy = fdf_bvalues(pline,4)
469 sxz = fdf_bvalues(pline,5)
470 syz = fdf_bvalues(pline,6)
471+ call fdf_bclose(bfdf)
472+
473 target_stress(1,1) = - sxx * tp
474 target_stress(2,2) = - syy * tp
475 target_stress(3,3) = - szz * tp
476
477=== modified file 'Src/m_ts_io_ctype.f90'
478--- Src/m_ts_io_ctype.f90 2018-05-04 10:51:06 +0000
479+++ Src/m_ts_io_ctype.f90 2018-09-09 19:50:11 +0000
480@@ -98,26 +98,11 @@
481 character(len=*), intent(in) :: suffix
482 integer :: n
483
484- ! prepare to read in the data...
485- type(block_fdf) :: bfdf
486- type(parsed_line), pointer :: pline => null()
487-
488- logical :: found
489-
490- n = 0
491 if ( len_trim(suffix) == 0 ) then
492- found = fdf_block(trim(prefix)//'.Contours',bfdf)
493+ n = fdf_block_linecount(trim(prefix)//'.Contours', 'l')
494 else
495- found = fdf_block(trim(prefix)//'.Contours.'//trim(suffix),bfdf)
496+ n = fdf_block_linecount(trim(prefix)//'.Contours'//trim(suffix), 'l')
497 end if
498- if ( .not. found ) return
499-
500- ! first count the number of electrodes
501- n = 0
502- do while ( fdf_bline(bfdf,pline) )
503- if ( fdf_bnnames(pline) == 0 ) cycle
504- n = n + 1
505- end do
506
507 end function fdf_nc_iotype
508
509@@ -143,15 +128,16 @@
510 end if
511 if ( .not. found ) return
512
513- ! first count the number of electrodes
514+ ! Find the name of the contour
515 n = 0
516 do while ( fdf_bline(bfdf,pline) )
517- if ( fdf_bnnames(pline) == 0 ) cycle
518- n = n + 1
519- if ( n == i ) then
520- name = fdf_bnames(pline,1)
521- return
522- end if
523+ if ( fdf_bnnames(pline) == 0 ) cycle
524+ n = n + 1
525+ if ( n == i ) then
526+ name = fdf_bnames(pline,1)
527+ call fdf_bclose(bfdf)
528+ return
529+ end if
530 end do
531
532 end function fdf_name_c_iotype
533@@ -226,7 +212,6 @@
534 type(block_fdf), optional :: bfdf
535 logical :: exist
536
537- type(block_fdf) :: bfdf_tmp
538 character(len=c_N) :: g
539
540 ! if the block does not exist, return
541@@ -242,7 +227,7 @@
542 bfdf%label = trim(g)
543 end if
544 else
545- exist = fdf_block(trim(g),bfdf_tmp)
546+ exist = fdf_isblock(trim(g))
547 end if
548
549 end function ts_exists_contour_block
550
551=== modified file 'Src/m_ts_kpoints.F90'
552--- Src/m_ts_kpoints.F90 2017-11-23 14:17:27 +0000
553+++ Src/m_ts_kpoints.F90 2018-09-09 19:50:11 +0000
554@@ -131,6 +131,7 @@
555 'kgrid_Monkhorst_Pack block' )
556 endif
557 enddo
558+ call fdf_bclose(bfdf)
559 ts_firm_displ = .true.
560
561 else
562
563=== modified file 'Src/meshsubs.F'
564--- Src/meshsubs.F 2017-07-01 00:59:38 +0000
565+++ Src/meshsubs.F 2018-09-09 19:50:11 +0000
566@@ -334,6 +334,7 @@
567 else
568 call die('initmesh: ERROR in MeshSizes block')
569 endif
570+ call fdf_bclose(bfdf)
571 RealCutoff = huge(1.0_dp)
572 call chkgmx( k0, rcell, ntm, RealCutoff )
573 if (RealCutoff < G2max) then
574
575=== modified file 'Src/metaforce.F'
576--- Src/metaforce.F 2016-01-25 16:00:16 +0000
577+++ Src/metaforce.F 2018-09-09 19:50:11 +0000
578@@ -11,13 +11,12 @@
579
580 implicit none
581
582- integer, save :: maxGauss = 100
583 integer, save :: nGauss = 0
584- logical, save :: lMetaForce
585- integer, pointer, save :: nGaussPtr(:,:)
586- real(dp), pointer, save :: GaussK(:)
587- real(dp), pointer, save :: GaussR0(:)
588- real(dp), pointer, save :: GaussZeta(:)
589+ logical, save :: lMetaForce = .false.
590+ integer, pointer, save :: nGaussPtr(:,:) => null()
591+ real(dp), pointer, save :: GaussK(:) => null()
592+ real(dp), pointer, save :: GaussR0(:) => null()
593+ real(dp), pointer, save :: GaussZeta(:) => null()
594
595 CONTAINS
596
597@@ -41,34 +40,42 @@
598 type(block_fdf) :: bfdf
599 type(parsed_line), pointer :: pline
600
601-C Find if there are any Gaussians specified
602- lMetaForce = fdf_defined('MetaForce')
603- if (lMetaForce) then
604+C Find if there are any Gaussians specified
605+ nGauss = fdf_block_linecount('MetaForce', 'iirrr')
606+ lMetaForce = nGauss > 0
607+ if ( lMetaForce ) then
608
609 C Allocate arrays for Gaussian data
610- call re_alloc( nGaussPtr, 1, 2, 1, maxGauss, 'nGaussPtr',
611+ call re_alloc( nGaussPtr, 1, 2, 1, nGauss, 'nGaussPtr',
612 & 'initmeta' )
613- call re_alloc( GaussK, 1, maxGauss, 'GaussK', 'initmeta' )
614- call re_alloc( GaussR0, 1, maxGauss, 'GaussR0', 'initmeta' )
615- call re_alloc( GaussZeta, 1, maxGauss, 'GaussZeta', 'initmeta' )
616+ call re_alloc( GaussK, 1, nGauss, 'GaussK', 'initmeta' )
617+ call re_alloc( GaussR0, 1, nGauss, 'GaussR0', 'initmeta' )
618+ call re_alloc( GaussZeta, 1, nGauss, 'GaussZeta', 'initmeta' )
619
620 C Read Gaussians from block
621- lMetaForce = fdf_block('MetaForce',bfdf)
622+ lMetaForce = fdf_block('MetaForce', bfdf)
623
624- do k= 1, maxGauss
625+ do while ( fdf_bline(bfdf, pline) )
626 C Read and parse data line
627- if (.not. fdf_bline(bfdf,pline))
628- . call die('initmeta: ERROR in MetaForce block')
629 ni = fdf_bnintegers(pline)
630 nr = fdf_bnreals(pline)
631
632 C Check that correct info is given
633 if ((ni .ge. 2) .and. (nr .ge. 3)) then
634 nGauss = nGauss + 1
635+ ! Atom 1
636 nGaussPtr(1,nGauss) = abs(fdf_bintegers(pline,1))
637+ ! Atom 2
638 nGaussPtr(2,nGauss) = abs(fdf_bintegers(pline,2))
639+ ! Gaussian pre-factor for the force
640+ ! Unit: Ry
641 GaussK(nGauss) = fdf_breals(pline,1)
642+ ! Distance in r - r_0, where r is the distance between
643+ ! atom i and j
644+ ! Unit: Ang
645 GaussR0(nGauss) = fdf_breals(pline,2)/0.529177_dp
646+ ! Gaussian prefactor
647+ ! Unit: 1/Bohr**2
648 GaussZeta(nGauss) = fdf_breals(pline,3)
649 endif
650 enddo
651
652=== modified file 'Src/projected_DOS.F'
653--- Src/projected_DOS.F 2018-06-25 11:33:42 +0000
654+++ Src/projected_DOS.F 2018-09-09 19:50:11 +0000
655@@ -22,17 +22,15 @@
656 subroutine init_projected_DOS()
657
658 USE siesta_options
659- use fdf, only: fdf_block, block_fdf
660+ use fdf, only: fdf_block, fdf_isblock
661 use Kpoint_pdos
662 use parallel, only: IOnode, Nodes
663 use siesta_geom, only: ucell
664 use m_spin, only: spin
665
666- type(block_fdf) :: bfdf
667-
668 !-------------------------------------------------------------------------BEGIN
669 ! Compute the projected density of states
670- do_pdos = fdf_block('ProjectedDensityOfStates', bfdf)
671+ do_pdos = fdf_isblock('ProjectedDensityOfStates')
672 if ( .not. do_pdos ) return
673
674 if (isolve.ne.SOLVE_DIAGON) then
675@@ -108,6 +106,7 @@
676 $ 'siesta: e1, e2, sigma, nhist: ',
677 $ e1/eV,' eV',e2/eV,' eV',sigma/eV,' eV', nhist
678 end if
679+ call fdf_bclose(bfdf)
680
681 ! If the k points have been set specifically for the PDOS then use this set
682 if (different_pdos_grid) then
683
684=== modified file 'Src/read_xc_info.F'
685--- Src/read_xc_info.F 2016-01-25 16:00:16 +0000
686+++ Src/read_xc_info.F 2018-09-09 19:50:11 +0000
687@@ -78,6 +78,7 @@
688 XCweightC(n) = 1.0_dp
689 endif
690 enddo
691+ call fdf_bclose(bfdf)
692 else
693 nXCfunc = 1
694 XCfunc(1) = fdf_string('xc.functional','LDA')
695
696=== modified file 'Src/readsp.F'
697--- Src/readsp.F 2016-01-25 16:00:16 +0000
698+++ Src/readsp.F 2018-09-09 19:50:11 +0000
699@@ -84,6 +84,7 @@
700 call die('redata: ERROR: ReciprocalCoordinates must be' //
701 . ' ''Cubic'' or ''ReciprocalLatticeVectors''')
702 endif
703+ call fdf_bclose(bfdf)
704 else
705 spiral = .false.
706 q(1) = 0.d0
707
708=== modified file 'Src/redcel.F'
709--- Src/redcel.F 2016-01-25 16:00:16 +0000
710+++ Src/redcel.F 2018-09-09 19:50:11 +0000
711@@ -43,8 +43,8 @@
712
713 C Lattice vectors
714
715- if ( fdf_block('LatticeParameters',bfdf) .and.
716- . fdf_block('LatticeVectors',bfdf) ) then
717+ if ( fdf_isblock('LatticeParameters') .and.
718+ . fdf_isblock('LatticeVectors') ) then
719 call die('redcel: ERROR: Lattice vectors doubly ' //
720 $ 'specified: by LatticeVectors and by LatticeParameters.')
721 endif
722@@ -97,6 +97,7 @@
723 cell(i,i) = 1.0_dp
724 enddo
725 endif
726+ call fdf_bclose(bfdf)
727
728 ! Note that cell will be zero if alat is not specified
729 ! This is not very intuitive
730@@ -117,6 +118,7 @@
731 mscell(2,i) = fdf_bvalues(pline,2)
732 mscell(3,i) = fdf_bvalues(pline,3)
733 enddo
734+ call fdf_bclose(bfdf)
735 else
736 do i = 1,3
737 do j = 1,3
738
739=== modified file 'Src/reoptical.F'
740--- Src/reoptical.F 2016-03-21 22:47:29 +0000
741+++ Src/reoptical.F 2018-09-09 19:50:11 +0000
742@@ -138,6 +138,7 @@
743 nmeshk(1) = fdf_bintegers(pline,1)
744 nmeshk(2) = fdf_bintegers(pline,2)
745 nmeshk(3) = fdf_bintegers(pline,3)
746+ call fdf_bclose(bfdf)
747 endif
748
749 C Read whether this is a polarised, unpolarised or polycrystal calc
750
751=== modified file 'Src/zm_broyden_optim.F'
752--- Src/zm_broyden_optim.F 2016-03-01 14:24:48 +0000
753+++ Src/zm_broyden_optim.F 2018-09-09 19:50:11 +0000
754@@ -175,7 +175,8 @@
755 sxy = fdf_bvalues(pline,4)
756 sxz = fdf_bvalues(pline,5)
757 syz = fdf_bvalues(pline,6)
758-
759+ call fdf_bclose(bfdf)
760+
761 tstres(1,1) = - sxx * tp
762 tstres(2,2) = - syy * tp
763 tstres(3,3) = - szz * tp
764
765=== modified file 'version.info'
766--- version.info 2018-09-08 04:18:59 +0000
767+++ version.info 2018-09-09 19:50:11 +0000
768@@ -1,1 +1,1 @@
769-siesta-4.1--983
770+siesta-4.1--983--fdf-close-1

Subscribers

People subscribed via source and target branches