Branch data Line data Source code
1 : : !!****m* ABINIT/m_nctk
2 : : !! NAME
3 : : !! m_nctk
4 : : !!
5 : : !! FUNCTION
6 : : !! Tools and wrappers for NETCDF-IO.
7 : : !!
8 : : !! COPYRIGHT
9 : : !! Copyright (C) 2008-2026 ABINIT group (MG)
10 : : !! This file is distributed under the terms of the
11 : : !! GNU General Public License, see ~abinit/COPYING
12 : : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : : !!
14 : : !! TODO
15 : : !! Remove create_nc_file, write_var_netcdf, the output of OUT.nc is dangereous
16 : : !! because we can create too many dimensions and get
17 : : !! nf90_def_dim - NetCDF library returned: NetCDF: NC_MAX_DIMS exceeded
18 : : !! Moreover the multiple calls to redef render the IO very inefficient
19 : : !! That part should be rationalized!
20 : : !!
21 : : !! SOURCE
22 : :
23 : : #if defined HAVE_CONFIG_H
24 : : #include "config.h"
25 : : #endif
26 : :
27 : : #include "abi_common.h"
28 : :
29 : : MODULE m_nctk
30 : :
31 : : use, intrinsic :: iso_c_binding
32 : : use defs_basis
33 : : use m_abicore
34 : : use m_build_info
35 : : use m_errors
36 : : use m_xmpi
37 : : use netcdf
38 : :
39 : : use m_fstrings, only : itoa, sjoin, lstrip, char_count, strcat, endswith, startswith, ltoa
40 : : use m_io_tools, only : pick_aname, delete_file, file_exists
41 : : use m_yaml, only : DTSET_IDX
42 : :
43 : : implicit none
44 : :
45 : : private
46 : : !!***
47 : :
48 : : integer,public,parameter :: nctk_noid = -huge(1)
49 : : ! This value is used to signal to procedures that IO should not be performed.
50 : :
51 : : ! Basic variables
52 : : character(len=*),public,parameter :: etsfio_file_format = "ETSF Nanoquanta"
53 : : character(len=*),public,parameter :: etsfio_conventions = "http://www.etsf.eu/fileformats/"
54 : :
55 : : integer,public,parameter :: etsfio_charlen = abi_slen
56 : : ! The value corresponding to character_string_len
57 : :
58 : : real,public,parameter :: etsfio_version = 3.3
59 : : ! This is clearly wrong because one should use strings instad of floats that cannot be represented exactly
60 : : ! but, unfortunately, it's in the specifications and we have to live with it!
61 : :
62 : : integer,public,parameter :: nctk_max_dims = NF90_MAX_DIMS
63 : : ! Maximum number of dimensions
64 : :
65 : : integer,public,parameter :: nctk_slen = NF90_MAX_NAME
66 : : ! String length used for the names of dimensions and variables
67 : : ! The maximum allowable number of characters
68 : :
69 : : ! netcdf4-hdf5 is the default
70 : : integer,save,private :: def_cmode_for_seq_create = ior(ior(nf90_clobber, nf90_netcdf4), nf90_write)
71 : : ! netcdf4 classic
72 : : !integer,save,private :: def_cmode_for_seq_create = ior(nf90_clobber, nf90_write)
73 : :
74 : : character(len=5),private,parameter :: NCTK_IMPLICIT_DIMS(10) = [ &
75 : : "one ", "two ", "three", "four ", "five ", "six ", "seven", "eight", "nine ", "ten "]
76 : :
77 : : !!****t* m_nctk/nctkerr_t
78 : : !! NAME
79 : : !! nctkerr_t
80 : : !!
81 : : !! FUNCTION
82 : : !!
83 : : !! SOURCE
84 : : !!
85 : : type,private :: nctkerr_t
86 : : integer :: ncerr = nf90_noerr
87 : : integer :: line = 0
88 : : character(len=fnlen) :: file = "Dummy File"
89 : : character(len=2048) :: msg="No error detected"
90 : : end type nctkerr_t
91 : : !!***
92 : :
93 : : type(nctkerr_t),private,save :: einfo
94 : :
95 : : !!****t* m_nctk/ncfdim_t
96 : : !! NAME
97 : : !! nctkdim_t
98 : : !!
99 : : !! FUNCTION
100 : : !! Stores the name and the value of a netcdf dimension
101 : : !!
102 : : !! SOURCE
103 : :
104 : : type,public :: nctkdim_t
105 : : character(len=nctk_slen) :: name ! name of the dimension.
106 : : integer :: value ! value of the dimension.
107 : : !integer :: id
108 : : end type nctkdim_t
109 : : !!***
110 : :
111 : : !!****t* m_nctk/nctkarr_t
112 : : !! NAME
113 : : !! nctkarr_t
114 : : !!
115 : : !! FUNCTION
116 : : !! Stores the name and the shape of a netcdf array
117 : : !!
118 : : !! SOURCE
119 : :
120 : : type,public :: nctkarr_t
121 : : character(len=nctk_slen) :: name ! name of the array.
122 : : character(len=4) :: dtype ! string specifying the type.
123 : : character(len=nctk_slen) :: shape_str ! string with the shape. e.g. "dim1, dim2" for [dim1, dim2] array.
124 : : end type nctkarr_t
125 : : !!***
126 : :
127 : : !!****s* m_nctk/nctkvar_t
128 : : !! NAME
129 : : !! nctkvar_t
130 : : !!
131 : : !! FUNCTION
132 : : !! This structure stores variable information, such as
133 : : !! name, NetCDF id, type, shape and dimensions. It contains the following elements:
134 : : !!
135 : : !! SOURCE
136 : :
137 : : type nctkvar_t
138 : :
139 : : integer :: id
140 : : ! the id used by NetCDF to access this variable.
141 : :
142 : : integer :: xtype
143 : : ! the type of the variable
144 : :
145 : : integer :: ndims
146 : : ! the number of dimensions (0 for scalar variable).
147 : :
148 : : integer :: natts
149 : : ! The number of attributes associated to the variable
150 : :
151 : : character(len=nctk_slen) :: name
152 : : ! the variable name.
153 : :
154 : : character(len=nctk_slen) :: dimnames(nctk_max_dims)
155 : : ! the name corresponding to each dimension
156 : : ! Only if array variable, only (1:ndims) are relevent
157 : :
158 : : integer :: dimids(nctk_max_dims) = -1
159 : : ! The id of the dimensions. only (1:ndims) are relevent
160 : :
161 : : integer :: dimlens(nctk_max_dims) = 0
162 : : ! the size for each dimension if array variable, only (1:ndims) are relevent
163 : :
164 : : !character(len=nctk_slen) :: dimnames(nctk_max_dims)
165 : : !character(len=nctk_slen), pointer :: ncattnames(:)
166 : : ! * ncattnames: the name corresponding to all associated attributes
167 : :
168 : : end type nctkvar_t
169 : : !!***
170 : :
171 : : public :: nctk_use_classic_for_seq ! Use netcdf-classic for files that are used in sequential.
172 : : ! instead of the default that is netcdf4/hdf5.
173 : : public :: nctk_idname ! Return the nc identifier from the name of the variable.
174 : : public :: nctk_idgroup ! Return the nc identifier from the name of a group.
175 : : public :: nctk_ncify ! Append ".nc" to ipath if ipath does not end with ".nc"
176 : : public :: nctk_string_from_occopt ! Return human-readable string with the smearing scheme.
177 : : public :: nctk_fort_or_ncfile ! Test wheter a path exists (fortran or nc file) and
178 : : ! select iomode depending on file extension.
179 : : public :: nctk_try_fort_or_ncfile ! Return fortran or netcdf filename depending on the existence of the file.
180 : : public :: nctk_test_mpiio ! Test at run-time whether the netcdf library supports parallel IO.
181 : : public :: nctk_test_mpiio_rw ! Write and read back a file with MPI-IO (independent, collective, deflate).
182 : :
183 : : public :: ab_define_var ! Helper function used to declare a netcdf variable.
184 : :
185 : : ! Helper functions
186 : : public :: nctk_open_read ! Open a file in read-only mode.
187 : : public :: nctk_open_create ! Create a netcdf file for modifications.
188 : : public :: nctk_open_modify ! Open an already existent file for modifications.
189 : : public :: nctk_add_etsf_header ! Add the ETSF-IO header.
190 : : public :: nctk_set_defmode ! Set the file in define mode (metadata)
191 : : public :: nctk_set_datamode ! Set the file in datamode (IO)
192 : : public :: nctk_set_collective ! Set collective access for a netcdf variable
193 : :
194 : : public :: nctk_def_dims ! Define dimensions in a netcdf file.
195 : : interface nctk_def_dims
196 : : module procedure nctk_def_one_dim
197 : : module procedure nctk_def_dim_list
198 : : end interface nctk_def_dims
199 : :
200 : : public :: nctk_set_atomic_units ! Set the value of the attributes "units" and "scale_to_atomic_units".
201 : : public :: nctk_def_basedims ! Define the basic dimensions used in ETSF-IO files.
202 : : public :: nctk_def_scalars_type ! Declare a list of scalars of the given type.
203 : : public :: nctk_def_iscalars ! Declare a list of integer scalars.
204 : : public :: nctk_def_dpscalars ! Declare a list of double precision scalars.
205 : : public :: nctk_write_iscalars ! Write a list of integer scalars.
206 : : public :: nctk_write_dpscalars ! Write a list of double precision scalars.
207 : : public :: nctk_defnwrite_ivars ! Declare and write a list of integer scalars.
208 : : public :: nctk_defnwrite_dpvars ! Declare and write a list of double precisions scalars.
209 : : public :: nctk_write_ibz ! Write k-points in the IBZ and corresponding weights.
210 : :
211 : : public :: nctk_def_one_array
212 : : public :: nctk_def_arrays ! Define netcdf arrays.
213 : :
214 : : interface nctk_def_arrays
215 : : module procedure nctk_def_one_array
216 : : module procedure nctk_def_array_list
217 : : end interface nctk_def_arrays
218 : :
219 : : public :: nctk_get_dim
220 : :
221 : : public :: nctk_write_datar
222 : : public :: nctk_read_datar
223 : : public :: nctk_prepare_mpiio
224 : : ! This function appears to be required to prevent deadlocks during I/O operations in single mode.
225 : : ! It's called automatically when using nctk_open_modify and nctk_open_read
226 : :
227 : : public :: create_nc_file ! FIXME: Deprecated
228 : : public :: write_var_netcdf ! FIXME: Deprecated
229 : : public :: write_eig ! FIXME: Deprecated
230 : :
231 : : !integer,save, protected, public :: nctk_cache_size = 32000000
232 : : ! If the cache_size is provided when opening a netCDF-4/HDF5 file, it will be used instead
233 : : ! of the default (32000000) as the size, in bytes, of the HDF5 chunk cache.
234 : :
235 : : !integer,save, protected, public :: nctk_cache_nelems = 1000
236 : : ! If cache_nelems is provided when opening a netCDF-4/HDF5 file, it will be used instead
237 : : ! of the default (1000) as the maximum number of elements in the HDF5 chunk cache.
238 : :
239 : : !real,save, protected, public :: nctk_cache_premtion = 0.75
240 : : ! If cache_preemption is provided when opening a netCDF-4/HDF5 file, it will be used
241 : : ! instead of the default (0.75) as the preemption value for the HDF5 chunk cache.
242 : :
243 : : logical, save, protected, public :: nctk_has_mpiio = .false.
244 : : ! This flag is set to true if the netcdf library supports parallel IO.
245 : : ! Cannot use CPP flags because nf90_open_par and other similar functions are always
246 : : ! exported by netcdf. As a consequence we have to check at run-time if we can
247 : : ! perform parallel IO and we use nctk_has_mpiio to select the IO algorithms.
248 : :
249 : : CONTAINS
250 : :
251 : :
252 : : !!****f* m_nctk/nctk_set_default_for_seq
253 : : !! NAME
254 : : !! nctk_set_default_for_seq
255 : : !!
256 : : !! FUNCTION
257 : : !! Use netcdf classic mode for new files when only sequential-IO needs to be performed
258 : : !!
259 : : !! SOURCE
260 : :
261 : 0 : subroutine nctk_use_classic_for_seq()
262 : :
263 : : ! Use netcdf classic mode.
264 : 0 : def_cmode_for_seq_create = ior(nf90_clobber, nf90_write)
265 : 0 : ABI_COMMENT("Using netcdf-classic mode")
266 : :
267 : 0 : end subroutine nctk_use_classic_for_seq
268 : : !!***
269 : :
270 : : !----------------------------------------------------------------------
271 : :
272 : : !!****f* m_nctk/nctk_idname
273 : : !! NAME
274 : : !! nctk_idname
275 : : !!
276 : : !! FUNCTION
277 : : !! Return the nc identifier from the name of the variable
278 : : !!
279 : : !! SOURCE
280 : :
281 : 2981406 : integer function nctk_idname(ncid, varname) result(varid)
282 : :
283 : : !Arguments ------------------------------------
284 : : integer,intent(in) :: ncid
285 : : character(len=*),intent(in) :: varname
286 : :
287 : : !Local variables-------------------------------
288 : : !scalars
289 : : integer :: ncerr
290 : : character(len=1000) :: msg
291 : : ! *********************************************************************
292 : :
293 : 2981406 : ncerr = nf90_inq_varid(ncid, varname, varid)
294 : :
295 [ - + ]: 2981406 : if (ncerr /= nf90_noerr) then
296 : : write(msg,'(6a)')&
297 [ # # ]: 0 : "NetCDF library returned: `",trim(nf90_strerror(ncerr)), "`", ch10,&
298 : 0 : "while trying to get the ncid of variable: ",trim(varname)
299 : 0 : ABI_ERROR(msg)
300 : : end if
301 : :
302 : 2981406 : end function nctk_idname
303 : : !!***
304 : :
305 : : !----------------------------------------------------------------------
306 : :
307 : : !!****f* m_nctk/nctk_idgroup
308 : : !! NAME
309 : : !! nctk_idgroup
310 : : !!
311 : : !! FUNCTION
312 : : !! Return the nc identifier from the name of a group
313 : : !!
314 : : !! SOURCE
315 : :
316 : 17250 : integer function nctk_idgroup(ncid, grpname) result(grpid)
317 : :
318 : : !Arguments ------------------------------------
319 : : integer,intent(in) :: ncid
320 : : character(len=*),intent(in) :: grpname
321 : :
322 : : !Local variables-------------------------------
323 : : integer :: ncerr
324 : : character(len=1000) :: msg
325 : : ! *********************************************************************
326 : :
327 : 17250 : ncerr = nf90_inq_ncid(ncid, grpname, grpid)
328 : :
329 [ - + ]: 17250 : if (ncerr /= nf90_noerr) then
330 : : write(msg,'(6a)')&
331 [ # # ]: 0 : "NetCDF library returned: `",trim(nf90_strerror(ncerr)), "`", ch10,&
332 : 0 : "while trying to get the ncid of group: ",trim(grpname)
333 : 0 : ABI_ERROR(msg)
334 : : end if
335 : :
336 : 17250 : end function nctk_idgroup
337 : : !!***
338 : :
339 : : !----------------------------------------------------------------------
340 : : !!****f* m_nctk/nctk_ncify
341 : : !! NAME
342 : : !! nctk_ncify
343 : : !!
344 : : !! FUNCTION
345 : : !! Append ".nc" to ipath if ipath does not end with ".nc"
346 : : !!
347 : : !! SOURCE
348 : :
349 : 57053 : function nctk_ncify(ipath) result(opath)
350 : :
351 : : character(len=*),intent(in) :: ipath
352 : : character(len=fnlen) :: opath
353 : : ! *********************************************************************
354 : :
355 : 57053 : if (.not. endswith(ipath, ".nc")) then
356 [ + + ]: 54754 : opath = trim(ipath)//'.nc'
357 : : else
358 [ - + ]: 2299 : opath = ipath
359 : : end if
360 : :
361 [ + + ]: 57053 : end function nctk_ncify
362 : : !!***
363 : :
364 : :
365 : : !----------------------------------------------------------------------
366 : :
367 : : !!****f* m_nctk/nctk_string_from_occopt
368 : : !! NAME
369 : : !! nctk_string_from_occopt
370 : : !!
371 : : !! FUNCTION
372 : : !!
373 : : !! SOURCE
374 : :
375 : 27860 : pure function nctk_string_from_occopt(occopt) result(smearing)
376 : :
377 : : integer,intent(in) :: occopt
378 : : character(len=etsfio_charlen) :: smearing
379 : : ! *********************************************************************
380 : :
381 : 29351 : select case (occopt)
382 : : case (3)
383 : 1491 : smearing = "Fermi-Dirac"
384 : : case (4)
385 : 1802 : smearing = "cold smearing of N. Marzari with minimization of the bump"
386 : : case (5)
387 : 42 : smearing = "cold smearing of N. Marzari with monotonic function in the tail"
388 : : case (6)
389 : 30 : smearing = "Methfessel and Paxton"
390 : : case (7)
391 : 3609 : smearing = "gaussian"
392 : : case (8)
393 : 0 : smearing = "uniform"
394 : : case default
395 [ + + + + : 27860 : smearing = "none"
+ - + ]
396 : : end select
397 : :
398 : 27860 : end function nctk_string_from_occopt
399 : : !!***
400 : :
401 : : !----------------------------------------------------------------------
402 : :
403 : : !!****f* m_nctk/nctk_fort_or_ncfile
404 : : !! NAME
405 : : !! nctk_fort_or_ncfile
406 : : !!
407 : : !! FUNCTION
408 : : !! Return the iomode used to perform IO operations on filename.
409 : : !! If filename does not exist, a similar file with extension `.nc` is tried
410 : : !! and iomode is set to IO_MODE_ETSF if the file exists.
411 : : !! This trick is used to run the Abinit test suite in netcdf mode without changing the input files.
412 : : !! The modification (if any) is logged to std_out.
413 : : !!
414 : : !! SIDE EFFECTS
415 : : !! filename=Tentative filename in input. Changed to netcdf file if input filename does not exist
416 : : !! and a file with netcdf extension is found.
417 : : !!
418 : : !! OUTPUT
419 : : !! iomode=Flag selecting the IO library. Set to IO_MODE_ETSF if netcdf file, else IO_MODE_MPI
420 : : !! if MPI supports it, finally IO_MODE_FORTRAN
421 : : !! errmsg=String with error message. Use `if (len_trim(errmsg) /= 0) ABI_ERROR(errmsg)`
422 : : !! to handle possible errors in the caller.
423 : : !!
424 : : !! SOURCE
425 : :
426 : 65 : subroutine nctk_fort_or_ncfile(filename, iomode, errmsg)
427 : :
428 : : character(len=*),intent(inout) :: filename
429 : : character(len=*),intent(out) :: errmsg
430 : : integer,intent(out) :: iomode
431 : : ! *********************************************************************
432 : 65 : errmsg = ""
433 : :
434 : : ! Default value
435 : : #ifdef HAVE_MPI_IO
436 : 65 : iomode = IO_MODE_MPI
437 : : #else
438 : : iomode = IO_MODE_FORTRAN
439 : : #endif
440 : :
441 : : ! Checking the existence of data file
442 [ + + ]: 65 : if (.not.file_exists(filename)) then
443 : : ! Trick needed to run Abinit test suite in netcdf mode.
444 [ + - ]: 50 : if (file_exists(nctk_ncify(filename))) then
445 : 50 : write(std_out,"(3a)")"- File: ",trim(filename)," does not exist but found netcdf file with similar name."
446 [ + - - + ]: 100 : filename = nctk_ncify(filename); iomode = IO_MODE_ETSF
447 : : end if
448 [ - + ]: 50 : if (.not. file_exists(filename)) then
449 [ # # # # ]: 0 : errmsg = 'Missing file: '//trim(filename)
450 : : end if
451 : : end if
452 : :
453 [ + - ]: 65 : end subroutine nctk_fort_or_ncfile
454 : : !!***
455 : :
456 : : !----------------------------------------------------------------------
457 : :
458 : : !!****f* m_nctk/nctk_try_fort_or_ncfile
459 : : !! NAME
460 : : !! nctk_try_fort_or_ncfile
461 : : !!
462 : : !! FUNCTION
463 : : !! If filename does not exist, a similar file with extension `.nc` is tried
464 : : !! This trick is used to run the Abinit test suite in netcdf mode without changing the input files.
465 : : !! The modification (if any) is logged to unit (Default: std_out)
466 : : !!
467 : : !! SIDE EFFECTS
468 : : !! filename=Tentative filename in input. Changed to netcdf file if input filename does not exist
469 : : !! and a file with netcdf extension is found.
470 : : !!
471 : : !! OUTPUT
472 : : !! errmsg=String with error message if return value /= 0
473 : : !!
474 : : !! SOURCE
475 : :
476 : 11891 : integer function nctk_try_fort_or_ncfile(filename, errmsg, unit) result(ierr)
477 : :
478 : : !Arguments ------------------------------------
479 : : character(len=*),intent(inout) :: filename
480 : : character(len=*),intent(out) :: errmsg
481 : : integer,optional,intent(in) :: unit
482 : :
483 : : !Local variables-------------------------------
484 : : integer :: unt
485 : : ! *********************************************************************
486 : :
487 : 0 : unt = std_out; if (present(unit)) unt = unit
488 [ + - ]: 11891 : ierr = 0; errmsg = ""
489 : :
490 [ + + ]: 11891 : if (.not.file_exists(filename)) then
491 : : ! Try netcdf exists.
492 [ + - ]: 2523 : if (file_exists(nctk_ncify(filename))) then
493 [ + - ]: 2523 : if (unt /= dev_null) then
494 : 2523 : write(unt,"(3a)")"- File: ",trim(filename)," does not exist but found netcdf file with similar name."
495 : : end if
496 [ + - - + ]: 5046 : filename = nctk_ncify(filename)
497 : : end if
498 [ + - ]: 2523 : if (.not. file_exists(filename)) then
499 [ # # # # ]: 0 : ierr = 1; errmsg = 'Cannot find file: '//trim(filename)
500 : : end if
501 : : end if
502 : :
503 [ - + ]: 11891 : end function nctk_try_fort_or_ncfile
504 : : !!***
505 : :
506 : : !----------------------------------------------------------------------
507 : :
508 : : !!****f* m_nctk/nctk_test_mpiio
509 : : !! NAME
510 : : !! nctk_test_mpiio
511 : : !!
512 : : !! FUNCTION
513 : : !! Test at run-time whether the netcdf library supports parallel IO and
514 : : !! set the value of the module variable `nctk_has_mpiio`.
515 : : !! This is a COLLECTIVE routine that should be called by all processors
516 : : !! in MPI_COMM_WORLD at the beginning of the calculation
517 : : !!
518 : : !! INPUTS
519 : : !! [print_warning]=TRUE if a warning about paral_kgb use has to be printed
520 : : !! Optional, default=yes
521 : : !!
522 : : !! SOURCE
523 : :
524 : 1460 : subroutine nctk_test_mpiio(print_warning)
525 : :
526 : : logical,intent(in),optional :: print_warning
527 : :
528 : : !Local variables-------------------------------
529 : : !scalars
530 : : logical :: my_print_warning
531 : : #ifdef HAVE_NETCDF_MPI
532 : : integer,parameter :: master=0
533 : : integer :: ierr,ncid,ncerr
534 : : character(len=500) :: msg
535 : : character(len=fnlen) :: apath
536 : : #endif
537 : : ! *********************************************************************
538 : :
539 : 1460 : nctk_has_mpiio = .False.
540 [ + + ]: 1460 : my_print_warning=.true. ; if (present(print_warning)) my_print_warning=print_warning
541 : :
542 : : !FIXME nf90create fails when using NVHPC
543 : : ! This might be due to my environment, maybe not, need to investigate this...
544 : : !!#ifndef FC_NVHPC
545 : : #ifdef HAVE_NETCDF_MPI
546 [ + + ]: 1460 : if (xmpi_comm_rank(xmpi_world) == master) then
547 : : ! Try to open a file with hdf5.
548 : 1179 : apath = pick_aname()
549 : : ncerr = nf90_create(apath, cmode=ior(ior(nf90_netcdf4, nf90_mpiio), nf90_write), ncid=ncid, &
550 : 1179 : comm=xmpi_comm_self, info=xmpio_info)
551 : :
552 [ + - ]: 1179 : if (ncerr == nf90_noerr) then
553 : 1179 : nctk_has_mpiio = .True.
554 : 1179 : call wrtout(std_out," Netcdf library supports MPI-IO", "COLL")
555 [ # # ]: 0 : else if (ncerr == nf90_enopar) then
556 : : ! This is the value returned by the C function ifndef USE_PARALLEL
557 : 0 : ABI_WARNING(sjoin("Netcdf lib does not support MPI-IO and: ", nf90_strerror(ncerr)))
558 : 0 : nctk_has_mpiio = .False.
559 : : else
560 : : ! Maybe something wrong in the low-level layer!
561 : 0 : ABI_WARNING(sjoin("Strange, netcdf seems to support MPI-IO but: ", nf90_strerror(ncerr)))
562 : 0 : nctk_has_mpiio = .False.
563 : : end if
564 : :
565 : 1179 : ncerr = nf90_close(ncid)
566 : 1179 : call delete_file(apath, ierr)
567 : : end if
568 : :
569 : : ! Master broadcast nctk_has_mpiio
570 : 1460 : call xmpi_bcast(nctk_has_mpiio,master,xmpi_world,ierr)
571 : :
572 [ - + - - ]: 1460 : if ((.not. nctk_has_mpiio) .and. my_print_warning) then
573 : : write(msg,"(5a)") &
574 : 0 : "The netcdf library does not support parallel IO, see message above",ch10,&
575 : 0 : "Abinit won't be able to produce files in parallel when e.g. paral_kgb == 1 is used.",ch10,&
576 : 0 : "Action: install a netcdf4+HDF5 library with MPI-IO support."
577 : 0 : ABI_WARNING(msg)
578 : : end if
579 : : #endif
580 : : !!#endif
581 : :
582 : : #ifdef HAVE_NETCDF_DEFAULT
583 [ - + ]: 1460 : if (.not. nctk_has_mpiio) then
584 : 0 : ABI_ERROR("--netcdf-default is on but netcdf library does not support MPI-IO. Aborting now")
585 : : end if
586 : : #endif
587 : :
588 : 1460 : end subroutine nctk_test_mpiio
589 : : !!***
590 : :
591 : : !----------------------------------------------------------------------
592 : :
593 : : !!****f* m_nctk/nctk_test_mpiio_rw
594 : : !! NAME
595 : : !! nctk_test_mpiio_rw
596 : : !!
597 : : !! FUNCTION
598 : : !! Write and read back a netcdf4 file with MPI-IO and check the data. Each rank of comm writes and reads
599 : : !! its own slice of three variables: "independent" (independent access, the ranks write one after the other),
600 : : !! "collective" (collective access) and "deflate" (compressed, collective access is required for filtered
601 : : !! variables). Used to validate the netcdf/HDF5/MPI-IO stack (`ioprof nc_mpiio`).
602 : : !! This is a COLLECTIVE routine that must be called by all the processors in comm.
603 : : !!
604 : : !! INPUTS
605 : : !! path = Name of the file. It is overwritten if it exists and it is not deleted.
606 : : !! nband = Number of complex entries written by each rank.
607 : : !! comm = MPI communicator.
608 : : !!
609 : : !! OUTPUT
610 : : !! ierr = Number of failed checks summed over the ranks and the variables.
611 : : !! -1 if the netcdf library does not support MPI-IO.
612 : : !!
613 : : !! SOURCE
614 : :
615 : 0 : subroutine nctk_test_mpiio_rw(path, nband, comm, ierr)
616 : :
617 : : !Arguments ------------------------------------
618 : : character(len=*),intent(in) :: path
619 : : integer,intent(in) :: nband, comm
620 : : integer,intent(out) :: ierr
621 : :
622 : : !Local variables-------------------------------
623 : : #ifdef HAVE_NETCDF_MPI
624 : : integer,parameter :: nvars = 3
625 : : integer :: ncid, ncerr, my_rank, nprocs, rank, iv, ib, nfail, mpierr
626 : : logical :: independent
627 : : character(len=500) :: msg
628 : : character(len=24),parameter :: varnames(nvars) = [character(len=24) :: "independent", "collective", "deflate"]
629 : : integer :: start3(3), count3(3)
630 : : real(dp),allocatable :: waves(:,:), read_waves(:,:)
631 : : #endif
632 : : ! *********************************************************************
633 : :
634 : 0 : ierr = -1
635 : : #ifdef HAVE_NETCDF_MPI
636 : 0 : my_rank = xmpi_comm_rank(comm); nprocs = xmpi_comm_size(comm)
637 : :
638 : : ! Reference data: different on each rank.
639 [ # # # # : 0 : ABI_MALLOC(waves, (2, nband))
# # # # #
# # # ]
640 [ # # # # : 0 : ABI_MALLOC(read_waves, (2, nband))
# # # # ]
641 [ # # ]: 0 : do ib=1,nband
642 : 0 : waves(1, ib) = one * ib * (my_rank + 1)
643 : 0 : waves(2, ib) = ten * ib * (my_rank + 1)
644 : : end do
645 [ # # # # ]: 0 : start3 = [1, 1, my_rank + 1]; count3 = [2, nband, 1]
646 : :
647 : 0 : ncerr = nf90_create(path, cmode=ior(nf90_netcdf4, nf90_mpiio), comm=comm, info=xmpio_info, ncid=ncid)
648 [ # # ]: 0 : NCF_CHECK_MSG(ncerr, sjoin("creating:", path))
649 [ # # ]: 0 : ncerr = nctk_def_dims(ncid, [nctkdim_t("two", 2), nctkdim_t("nband", nband), nctkdim_t("nprocs", nprocs)], defmode=.True.)
650 [ # # ]: 0 : NCF_CHECK(ncerr)
651 [ # # ]: 0 : do iv=1,nvars
652 [ # # ]: 0 : NCF_CHECK(nctk_def_arrays(ncid, nctkarr_t(varnames(iv), "dp", "two, nband, nprocs")))
653 : : end do
654 [ # # ]: 0 : NCF_CHECK(nf90_def_var_deflate(ncid, nctk_idname(ncid, "deflate"), shuffle=1, deflate=1, deflate_level=5))
655 [ # # ]: 0 : NCF_CHECK(nctk_set_datamode(ncid))
656 : :
657 : : ! Independent access: the ranks write one after the other.
658 [ # # ]: 0 : NCF_CHECK(nctk_set_collective(ncid, nctk_idname(ncid, "independent"), independent=.True.))
659 [ # # ]: 0 : do rank=0,nprocs-1
660 [ # # ]: 0 : if (rank == my_rank) then
661 [ # # ]: 0 : NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, "independent"), waves, start=start3, count=count3))
662 : : end if
663 : 0 : call xmpi_barrier(comm)
664 : : end do
665 : :
666 : : ! Collective access, also for the compressed variable.
667 [ # # ]: 0 : do iv=2,nvars
668 [ # # ]: 0 : NCF_CHECK(nctk_set_collective(ncid, nctk_idname(ncid, varnames(iv))))
669 [ # # ]: 0 : NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, varnames(iv)), waves, start=start3, count=count3))
670 : : end do
671 [ # # ]: 0 : NCF_CHECK(nf90_close(ncid))
672 : 0 : call xmpi_barrier(comm)
673 : :
674 : : ! Read back with the same access mode and compare.
675 : 0 : ncerr = nf90_open(path, mode=ior(ior(nf90_netcdf4, nf90_mpiio), nf90_nowrite), comm=comm, info=xmpio_info, ncid=ncid)
676 [ # # ]: 0 : NCF_CHECK_MSG(ncerr, sjoin("opening:", path))
677 : 0 : ierr = 0
678 [ # # ]: 0 : do iv=1,nvars
679 : 0 : independent = varnames(iv) == "independent"
680 [ # # ]: 0 : NCF_CHECK(nctk_set_collective(ncid, nctk_idname(ncid, varnames(iv)), independent=independent))
681 [ # # # # ]: 0 : read_waves = zero
682 [ # # ]: 0 : NCF_CHECK(nf90_get_var(ncid, nctk_idname(ncid, varnames(iv)), read_waves, start=start3, count=count3))
683 [ # # # # : 0 : nfail = 0; if (any(read_waves /= waves)) nfail = 1
# # # # ]
684 : 0 : call xmpi_sum(nfail, comm, mpierr)
685 [ # # ]: 0 : if (nfail == 0) then
686 [ # # ]: 0 : write(msg, "(1x,a,t25,a)") trim(varnames(iv)), "[OK]"
687 : : else
688 [ # # ]: 0 : write(msg, "(1x,a,t25,a,i0,a,i0,a)") trim(varnames(iv)), "[FAILED] on ", nfail, " of ", nprocs, " ranks"
689 : : end if
690 : 0 : call wrtout(std_out, msg)
691 : 0 : ierr = ierr + nfail
692 : : end do
693 [ # # ]: 0 : NCF_CHECK(nf90_close(ncid))
694 : :
695 [ # # ]: 0 : ABI_FREE(waves)
696 [ # # ]: 0 : ABI_FREE(read_waves)
697 : : #else
698 : : ABI_UNUSED((/nband, comm/))
699 : : ABI_UNUSED(path)
700 : : #endif
701 : :
702 : 0 : end subroutine nctk_test_mpiio_rw
703 : : !!***
704 : :
705 : : !!****f* m_nctk/str2xtype
706 : : !! NAME
707 : : !! str2xtype
708 : : !!
709 : : !! FUNCTION
710 : : !! Return the netcdf type from a string. Possible values:
711 : : !! c or ch for NF90_CHAR
712 : : !! i or int for NF90_INTtrue
713 : : !! sp for NF90_FLOAT
714 : : !! dp for NF90_DOUBLE
715 : : !!
716 : : !! SOURCE
717 : :
718 : 1208208 : integer function str2xtype(string) result(xtype)
719 : :
720 : : !Arguments ------------------------------------
721 : : character(len=*),intent(in) :: string
722 : : ! *********************************************************************
723 : :
724 : : !Type FORTRAN API Mnemonic Bits
725 : : !byte NF90_BYTE 8
726 : : !char NF90_CHAR 8
727 : : !short NF90_SHORT 16
728 : : !int NF90_INT 32
729 : : !float NF90_FLOAT 32
730 : : !double NF90_DOUBLE 64
731 : :
732 : : select case (string)
733 : : case ("c", "ch", "char")
734 : : xtype = NF90_CHAR
735 : : case ("i", "int")
736 : : xtype = NF90_INT
737 : : case ("sp")
738 : : xtype = NF90_FLOAT
739 : : case ("dp")
740 : 0 : xtype = NF90_DOUBLE
741 : : case default
742 [ + - ]: 1208208 : ABI_ERROR(sjoin("Invalid string type:", string))
743 : : end select
744 : :
745 : 1208208 : end function str2xtype
746 : : !!***
747 : :
748 : : !!****f* m_nctk/bail_if_ncerr
749 : : !! NAME
750 : : !! bail_if_ncerr
751 : : !!
752 : : !! FUNCTION
753 : : !!
754 : : !! INPUTS
755 : : !! ncerr=Netcdf error
756 : : !! line=line number of the file where problem occurred
757 : : !! file=name of the f90 file containing the caller
758 : : !!
759 : : !! SOURCE
760 : :
761 : : logical function bail_if_ncerr(ncerr, file, line) result(bail)
762 : :
763 : : !Arguments ------------------------------------
764 : : integer,intent(in) :: ncerr
765 : : character(len=*),optional,intent(in) :: file
766 : : integer,optional,intent(in) :: line
767 : : ! *********************************************************************
768 : :
769 : : bail = (ncerr /= nf90_noerr)
770 : :
771 : : if (bail) then
772 : : einfo%ncerr = ncerr
773 : : einfo%file = "Subroutine Unknown"; if (present(file)) einfo%file = file
774 : : einfo%line = 0; if (present(line)) einfo%line = line
775 : : ! Append Netcdf string to user-defined message.
776 : : write(einfo%msg,'(2a)')'NetCDF library raised: ',trim(nf90_strerror(ncerr))
777 : : end if
778 : :
779 : : end function bail_if_ncerr
780 : : !!***
781 : :
782 : : !----------------------------------------------------------------------
783 : :
784 : : !!****f* m_nctk/nctk_open_read
785 : : !! NAME
786 : : !! nctk_open_read
787 : : !!
788 : : !! FUNCTION
789 : : !! Open a netcdf file in read-only mode. Return exit status.
790 : : !!
791 : : !! INPUTS
792 : : !! ncid=Netcdf identifier.
793 : : !! comm=MPI communicator.
794 : : !!
795 : : !! SOURCE
796 : :
797 : 22149 : integer function nctk_open_read(ncid, path, comm) result(ncerr)
798 : :
799 : : !Arguments ------------------------------------
800 : : integer,intent(out) :: ncid
801 : : integer,intent(in) :: comm
802 : : character(len=*),intent(in) :: path
803 : :
804 : : !Local variables-------------------------------
805 : : integer :: nprocs
806 : : ! *********************************************************************
807 : :
808 : 22149 : nprocs = xmpi_comm_size(comm)
809 : :
810 : : ! Enforce netcdf4 only if the communicator contains more than one processor.
811 [ + + + + ]: 22149 : if (nctk_has_mpiio .and. nprocs > 1) then
812 : : #ifdef HAVE_NETCDF_MPI
813 : : ncerr = nf90_open(path, mode=ior(ior(nf90_netcdf4, nf90_mpiio), nf90_nowrite),&
814 : 48 : comm=comm, info=xmpio_info, ncid=ncid)
815 : : #else
816 : : ncerr = nf90_einval
817 : : ABI_WARNING("Netcdf without MPI support. Cannot open file, will abort in caller")
818 : : #endif
819 [ - + ]: 48 : NCF_CHECK_MSG(ncerr, sjoin("opening file:", path))
820 : : else
821 : 22101 : ncerr = nf90_open(path, mode=nf90_nowrite, ncid=ncid)
822 [ - + ]: 22101 : NCF_CHECK_MSG(ncerr, sjoin("Opening file:", path))
823 : : !if (ncerr /= NC_EHDFERR) then
824 : : ! ncerr = nf90_open(path, mode=ior(ior(nf90_netcdf4), nf90_nowrite), comm=comm, info=xmpio_info, ncid=ncid)
825 : : !end if
826 [ - + ]: 22101 : if (nprocs > 1) then
827 : 0 : ncerr = nf90_einval
828 : 0 : ABI_WARNING("netcdf without MPI-IO support with nprocs > 1! Will abort in the caller")
829 : : end if
830 : : end if
831 : :
832 : 22149 : end function nctk_open_read
833 : : !!***
834 : :
835 : : !----------------------------------------------------------------------
836 : :
837 : : !!****f* m_nctk/nctk_open_create
838 : : !! NAME
839 : : !! nctk_open_create
840 : : !!
841 : : !! FUNCTION
842 : : !! Create and open the netcdf file. Return exis status.
843 : : !!
844 : : !! INPUTS
845 : : !! path=Name of the file
846 : : !! comm=MPI communicator.
847 : : !!
848 : : !! OUTPUT
849 : : !! ncid=Netcdf identifier.
850 : : !!
851 : : !! SOURCE
852 : :
853 : 15982 : integer function nctk_open_create(ncid, path, comm) result(ncerr)
854 : :
855 : : !Arguments ------------------------------------
856 : : integer,intent(out) :: ncid
857 : : integer,intent(in) :: comm
858 : : character(len=*),intent(in) :: path
859 : :
860 : : !Local variables-------------------------------
861 : : integer :: input_len, cmode
862 : : character(len=strlen) :: my_string
863 : : ! *********************************************************************
864 : :
865 : : ! Always use mpiio mode (i.e. hdf5) if available so that one can perform parallel IO
866 [ + + ]: 15982 : if (nctk_has_mpiio) then
867 : 15744 : ncerr = nf90_einval
868 : : #ifdef HAVE_NETCDF_MPI
869 : 15744 : write(my_string,'(2a)') "- Creating HDf5 file with MPI-IO support: ",trim(path)
870 : 15744 : call wrtout(std_out, my_string)
871 : : ! Believe it or not, I have to use xmpi_comm_self even in sequential to avoid weird SIGSEV in the MPI layer!
872 : 15744 : ncerr = nf90_create(path, cmode=ior(ior(nf90_netcdf4, nf90_mpiio), nf90_write), ncid=ncid, comm=comm, info=xmpio_info)
873 : : #endif
874 : : else
875 : : ! Note that here we don't enforce nf90_netcdf4 hence the netcdf file with be in classic model.
876 : 238 : write(my_string,'(2a)') "- Creating HDf5 file WITHOUT MPI-IO support: ",trim(path)
877 : 238 : call wrtout(std_out, my_string)
878 : : !ncerr = nf90_create(path, ior(nf90_clobber, nf90_write), ncid)
879 : 238 : cmode = def_cmode_for_seq_create
880 : 238 : ncerr = nf90_create(path, cmode=cmode, ncid=ncid)
881 [ - + ]: 238 : if (xmpi_comm_size(comm) > 1) then
882 : 0 : ABI_WARNING("netcdf without MPI-IO support with nprocs > 1!")
883 : : end if
884 : : end if
885 [ - + ]: 15982 : NCF_CHECK(ncerr)
886 : :
887 : : ! Write etsf_header: file format, version and conventions.
888 [ - + ]: 15982 : NCF_CHECK(nf90_put_att(ncid, NF90_GLOBAL, "file_format", etsfio_file_format))
889 [ - + ]: 15982 : NCF_CHECK(nf90_put_att(ncid, NF90_GLOBAL, "file_format_version", etsfio_version))
890 [ - + ]: 15982 : NCF_CHECK(nf90_put_att(ncid, NF90_GLOBAL, "Conventions", etsfio_conventions))
891 : :
892 : : ! Add info on the code that produced this file. These are extensions not in the standard.
893 [ - + ]: 15982 : NCF_CHECK(nf90_put_att(ncid, NF90_GLOBAL, "code", "Abinit"))
894 [ - + ]: 15982 : NCF_CHECK(nf90_put_att(ncid, NF90_GLOBAL, "abinit_version", abinit_version))
895 : :
896 : : ! Define the basic dimensions used in ETSF-IO files.
897 [ - + ]: 15982 : NCF_CHECK(nctk_def_basedims(ncid, defmode=.True.))
898 : :
899 : : ! INPUT_STRING is allocated and initialized in parsefile
900 [ + + ]: 15982 : if (allocated(INPUT_STRING)) then
901 : : ! Write string with input.
902 [ + + ]: 15903 : my_string = trim(INPUT_STRING)
903 [ + + + + ]: 15903 : if (DTSET_IDX /= -1 .and. index(INPUT_STRING, "jdtset ") == 0) then
904 [ + - + + ]: 14116 : my_string = "jdtset " // trim(itoa(DTSET_IDX)) // " " // trim(INPUT_STRING)
905 : : end if
906 : :
907 : 15903 : input_len = len_trim(my_string)
908 [ - + ]: 15903 : NCF_CHECK(nctk_def_dims(ncid, nctkdim_t("input_len", input_len)))
909 [ - + ]: 15903 : NCF_CHECK(nctk_def_arrays(ncid, nctkarr_t("input_string", "c", "input_len")))
910 : : !print *, "input_len, strlen:", input_len, strlen
911 : :
912 [ + - ]: 15903 : if (xmpi_comm_rank(comm) == 0) then
913 [ - + ]: 15903 : NCF_CHECK(nctk_set_datamode(ncid))
914 : : ! Pass my_string(1:input_len)) instead from trim(string) to avoid SIGSEV on higgs_intel_19.0_serial
915 [ - + ]: 15903 : NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, "input_string"), my_string(1:input_len)))
916 [ - + ]: 15903 : NCF_CHECK(nctk_set_defmode(ncid))
917 : : end if
918 : : end if
919 : :
920 : 15982 : end function nctk_open_create
921 : : !!***
922 : :
923 : : !----------------------------------------------------------------------
924 : :
925 : : !!****f* m_nctk/nctk_open_modify
926 : : !! NAME
927 : : !! nctk_open_modfy
928 : : !!
929 : : !! FUNCTION
930 : : !! Open an already existent netcdf file for modifications. Return exit status.
931 : : !!
932 : : !! INPUTS
933 : : !! path=File name.
934 : : !! comm=MPI communicator.
935 : : !!
936 : : !! OUTPUT
937 : : !! ncid=Netcdf identifier.
938 : : !!
939 : : !! SOURCE
940 : :
941 : 11889 : integer function nctk_open_modify(ncid, path, comm) result(ncerr)
942 : :
943 : : !Arguments ------------------------------------
944 : : integer,intent(out) :: ncid
945 : : character(len=*),intent(in) :: path
946 : : integer,intent(in) :: comm
947 : : ! *********************************************************************
948 : :
949 [ + + - + ]: 11889 : if (.not. nctk_has_mpiio .and. xmpi_comm_size(comm) > 1) then
950 : 0 : ABI_ERROR("netcdf without MPI-IO support and nprocs > 1!")
951 : : end if
952 : :
953 [ + + + + ]: 11889 : if (xmpi_comm_size(comm) > 1 .or. nctk_has_mpiio) then
954 : 11888 : call wrtout(std_out, sjoin(" nctk_open_modify: Opening HDf5 file with MPI-IO support:", path))
955 : : #ifdef HAVE_NETCDF_MPI
956 : : ncerr = nf90_open_par(path, cmode=ior(ior(nf90_netcdf4, nf90_mpiio), nf90_write), &
957 : 11888 : comm=comm, info=xmpio_info, ncid=ncid)
958 [ - + ]: 11888 : NCF_CHECK_MSG(ncerr, sjoin("nf90_open_par: ", path))
959 : : #else
960 : : ABI_ERROR("nprocs > 1 but netcdf does not support MPI-IO")
961 : : #endif
962 : : else
963 : 1 : call wrtout(std_out, sjoin(" nctk_open_modify: Opening netcdf file without MPI-IO support:", path))
964 : 1 : ncerr = nf90_open(path, nf90_write, ncid)
965 [ - + ]: 1 : NCF_CHECK_MSG(ncerr, sjoin("nf90_open: ", path))
966 : : end if
967 : :
968 : : ! Set file in define mode.
969 [ - + ]: 11889 : NCF_CHECK(nctk_set_defmode(ncid))
970 : : !call wrtout(std_out, "- Returning from nctk_open_modify")
971 : :
972 : 11889 : end function nctk_open_modify
973 : : !!***
974 : :
975 : : !----------------------------------------------------------------------
976 : :
977 : : !!****f* m_nctk/nctk_add_etsf_header
978 : : !! NAME
979 : : !! nctk_add_etsf_header
980 : : !!
981 : : !! FUNCTION
982 : : !! Add the etsf-io header to a file associated to a netcdf file handler.
983 : : !!
984 : : !! INPUTS
985 : : !! ncid=Netcdf file identifier.
986 : : !! * version = the number of version to be created.
987 : : !! * title = (optional) a title for the file (80 characters max).
988 : : !! * history = (optional) the first line of history (1024 characters max).
989 : : !! * with_etsf_header = (optional) if true, will create a header
990 : : !! as defined in the ETSF specifications (default is .true.).
991 : : !! When value is .false., arguments title, history and version
992 : : !! are ignored.
993 : : !!
994 : : !! SOURCE
995 : :
996 : 4589 : integer function nctk_add_etsf_header(ncid, title, history) result(ncerr)
997 : :
998 : : !Arguments ------------------------------------
999 : : integer,intent(in) :: ncid
1000 : : character(len=*),optional,intent(in) :: title,history
1001 : :
1002 : : !Local variables-------------------------------
1003 : : !integer :: ncerr
1004 : : character(len=*), parameter :: file_format = "ETSF Nanoquanta"
1005 : : character(len=*), parameter :: conventions = "http://www.etsf.eu/fileformats/"
1006 : : real :: format_version = 3.3 ! Real is not a good choice for a version!
1007 : : ! *********************************************************************
1008 : :
1009 : 4589 : ncerr = nctk_set_defmode(ncid)
1010 [ + - ]: 4589 : if (ncerr /= nf90_noerr) return
1011 : :
1012 : : ! The file format
1013 : 4589 : ncerr = nf90_put_att(ncid, NF90_GLOBAL, "file_format", file_format)
1014 [ + - ]: 4589 : if (ncerr /= nf90_noerr) return
1015 : :
1016 : : ! The version
1017 : 4589 : ncerr = nf90_put_att(ncid, NF90_GLOBAL, "file_format_version", format_version)
1018 [ + - ]: 4589 : if (ncerr /= nf90_noerr) return
1019 : :
1020 : : ! The conventions
1021 : 4589 : ncerr = nf90_put_att(ncid, NF90_GLOBAL, "Conventions", conventions)
1022 [ + - ]: 4589 : if (ncerr /= nf90_noerr) return
1023 : :
1024 : : ! The history if present
1025 [ + - ]: 4589 : if (present(history)) then
1026 : 4589 : ncerr = nf90_put_att(ncid, NF90_GLOBAL, "history", history(1:min(1024, len(history))))
1027 [ + - ]: 4589 : if (ncerr /= nf90_noerr) return
1028 : : end if
1029 : :
1030 : : ! The title if present
1031 [ + - ]: 4589 : if (present(title)) then
1032 : 4589 : ncerr = nf90_put_att(ncid, NF90_GLOBAL, "title", title(1:min(80, len(title))))
1033 [ + - ]: 4589 : if (ncerr /= nf90_noerr) return
1034 : : end if
1035 : :
1036 : : ! These are extensions not in the standard.
1037 : : ! Add info on the code that produced this file
1038 : 4589 : ncerr = nf90_put_att(ncid, NF90_GLOBAL, "code", "Abinit")
1039 [ + - ]: 4589 : if (ncerr /= nf90_noerr) return
1040 : :
1041 : 4589 : ncerr = nf90_put_att(ncid, NF90_GLOBAL, "code_version", ABINIT_VERSION)
1042 : : if (ncerr /= nf90_noerr) return
1043 : :
1044 : : end function nctk_add_etsf_header
1045 : : !!***
1046 : :
1047 : : !----------------------------------------------------------------------
1048 : :
1049 : : !!****f* m_nctk/nctk_set_defmode
1050 : : !! NAME
1051 : : !! nctk_set_defmode
1052 : : !!
1053 : : !! FUNCTION
1054 : : !! Set the file in define mode, return exit status.
1055 : : !!
1056 : : !! INPUTS
1057 : : !! ncid=Netcdf identifier.
1058 : : !!
1059 : : !! SOURCE
1060 : :
1061 : 216141 : integer function nctk_set_defmode(ncid) result(ncerr)
1062 : :
1063 : : !Arguments ------------------------------------
1064 : : integer,intent(in) :: ncid
1065 : : ! *********************************************************************
1066 : :
1067 : 216141 : ncerr = nf90_redef(ncid)
1068 : : ! Use same trick as in etsf_io
1069 [ - + ]: 216141 : if (ncerr /= nf90_noerr .and. ncerr /= -39) then
1070 : 0 : NCF_CHECK(ncerr)
1071 : : else
1072 : 216141 : ncerr = nf90_noerr
1073 : : end if
1074 : :
1075 : 216141 : end function nctk_set_defmode
1076 : : !!***
1077 : :
1078 : : !----------------------------------------------------------------------
1079 : :
1080 : : !!****f* m_nctk/nctk_set_datamode
1081 : : !! NAME
1082 : : !! nctk_set_datamode
1083 : : !!
1084 : : !! FUNCTION
1085 : : !! Set the file in data mode. Return exit status
1086 : : !!
1087 : : !! INPUTS
1088 : : !! ncid=Netcdf identifier.
1089 : : !! [reserve]
1090 : : !!
1091 : : !! OUTPUT
1092 : : !! ncerr=Exit status
1093 : : !!
1094 : : !! SOURCE
1095 : :
1096 : 142556 : integer function nctk_set_datamode(ncid, reserve) result(ncerr)
1097 : :
1098 : : !Arguments ------------------------------------
1099 : : integer,intent(in) :: ncid
1100 : : logical,intent(in),optional :: reserve
1101 : :
1102 : : !Local variables-------------------------------
1103 : : !scalars
1104 : : logical :: do_reserve
1105 : : ! *********************************************************************
1106 : :
1107 : 142556 : do_reserve = .False.; if (present(reserve)) do_reserve = reserve
1108 : :
1109 : 142556 : ncerr = nf90_enddef(ncid)
1110 : :
1111 : : ! Use same trick as in etsf_io
1112 : : ! needed otherwise netcdf complains if the file is already in def mode.
1113 [ - + ]: 142556 : if (ncerr /= nf90_noerr .and. ncerr /= -38) then
1114 : 0 : NCF_CHECK(ncerr)
1115 : : else
1116 : 142556 : ncerr = nf90_noerr
1117 : : end if
1118 : :
1119 : 142556 : return
1120 : :
1121 : : ! TODO
1122 : : if (do_reserve) then
1123 : : ncerr = nf90_enddef(ncid)
1124 : : !ncerr = nf90__enddef(ncid)
1125 : : else
1126 : : ncerr = nf90_enddef(ncid)
1127 : : end if
1128 : :
1129 : : end function nctk_set_datamode
1130 : : !!***
1131 : :
1132 : : !----------------------------------------------------------------------
1133 : :
1134 : : !!****f* m_nctk/nctk_set_collective
1135 : : !! NAME
1136 : : !! nctk_set_collective
1137 : : !!
1138 : : !! FUNCTION
1139 : : !! Use collective IO for the given netcdf variable. Return exit status.
1140 : : !!
1141 : : !! INPUTS
1142 : : !! ncid=Netcdf file identifier.
1143 : : !! varid=Netcdf variable identifier.
1144 : : !! [independent]=True of use indepedent mode.
1145 : : !!
1146 : : !! SOURCE
1147 : :
1148 : 102598 : integer function nctk_set_collective(ncid, varid, independent) result(ncerr)
1149 : :
1150 : : !Arguments ------------------------------------
1151 : : integer,intent(in) :: ncid, varid
1152 : : logical,optional,intent(in) :: independent
1153 : :
1154 : : !Local variables-------------------------------
1155 : : logical :: independent__
1156 : : ! *********************************************************************
1157 : :
1158 : 102598 : ncerr = nf90_einval
1159 : 102338 : independent__ = .false.
1160 : : #ifdef HAVE_NETCDF_MPI
1161 [ - + ]: 102338 : if (present(independent)) independent__ = independent
1162 [ # # ]: 0 : if (independent__) then
1163 : 0 : ncerr = nf90_var_par_access(ncid, varid, nf90_independent)
1164 : : else
1165 : 102338 : ncerr = nf90_var_par_access(ncid, varid, nf90_collective)
1166 : : end if
1167 : : #else
1168 : : ABI_ERROR("nctk_set_collective should not be called if NETCDF does not support MPI-IO")
1169 : : ABI_UNUSED((/ncid, varid/))
1170 : : #endif
1171 : :
1172 : 102338 : end function nctk_set_collective
1173 : : !!***
1174 : :
1175 : : !!****f* m_nctk/nctk_def_one_dim
1176 : : !! NAME
1177 : : !! nctk_def_one_dim
1178 : : !!
1179 : : !! FUNCTION
1180 : : !! Define list of dimensions variables and write their values.
1181 : : !! Return immediately if error
1182 : : !!
1183 : : !! INPUTS
1184 : : !! ncid=Netcdf identifier.
1185 : : !! dimnames(:)=List of strings with the name of the dimensions
1186 : : !! values(:)=List of integer scalars
1187 : : !! [defmode]=If True, the nc file is set in define mode (default=False)
1188 : : !! [prefix]=Prefix added to varnames and dimensions. Empty string if not specified.
1189 : : !!
1190 : : !! SOURCE
1191 : :
1192 : 1351253 : integer function nctk_def_one_dim(ncid, nctkdim, defmode, prefix) result(ncerr)
1193 : :
1194 : : !Arguments ------------------------------------
1195 : : !scalars
1196 : : integer,intent(in) :: ncid
1197 : : logical,optional,intent(in) :: defmode
1198 : : character(len=*),optional,intent(in) :: prefix
1199 : : !arrays
1200 : : type(nctkdim_t),intent(in) :: nctkdim
1201 : :
1202 : : !Local variables-------------------------------
1203 : : integer :: dimid,dimlen
1204 : : character(len=nctk_slen) :: dname
1205 : : character(len=500) :: msg
1206 : : ! *********************************************************************
1207 : :
1208 : 1351253 : ncerr = nf90_noerr
1209 : :
1210 [ - + ]: 1351253 : if (present(defmode)) then
1211 [ # # ]: 0 : if (defmode) then
1212 [ # # ]: 0 : NCF_CHECK(nctk_set_defmode(ncid))
1213 : : end if
1214 : : end if
1215 : :
1216 [ + + ]: 1351253 : if (present(prefix)) then
1217 [ + + + - : 396 : if (any(nctkdim%name == NCTK_IMPLICIT_DIMS)) then
- + ]
1218 : 0 : dname = nctkdim%name
1219 : : else
1220 [ + - ]: 36 : dname = strcat(prefix, nctkdim%name)
1221 : : end if
1222 : : else
1223 : 1351217 : dname = nctkdim%name
1224 : : end if
1225 : :
1226 : : ! if dimension already exists, test whether it has the same value else define new dim.
1227 : 1351253 : ncerr = nf90_inq_dimid(ncid, dname, dimid)
1228 : :
1229 [ + + ]: 1351253 : if (ncerr == nf90_noerr) then
1230 [ - + ]: 514726 : NCF_CHECK(nf90_inquire_dimension(ncid, dimid, len=dimlen))
1231 [ - + ]: 514726 : if (dimlen /= nctkdim%value) then
1232 : : write(msg, "(4a,2(a,i0))")&
1233 : 0 : "dimension ", trim(dname)," already exists but with a different value",ch10,&
1234 : 0 : "from file: ", dimlen, "; about to write: ", nctkdim%value
1235 : 0 : ABI_ERROR(msg)
1236 : : end if
1237 : : else
1238 : 836527 : ncerr = nf90_def_dim(ncid, dname, nctkdim%value, dimid)
1239 [ - + ]: 836527 : NCF_CHECK(ncerr)
1240 : : end if
1241 : :
1242 : 1351253 : end function nctk_def_one_dim
1243 : : !!***
1244 : :
1245 : : !----------------------------------------------------------------------
1246 : :
1247 : : !!****f* m_nctk/nctk_def_dim_list
1248 : : !! NAME
1249 : : !! nctk_def_dim_list
1250 : : !!
1251 : : !! FUNCTION
1252 : : !! Define list of dimensions variables and write their values.
1253 : : !! Return immediately if error
1254 : : !!
1255 : : !! INPUTS
1256 : : !! ncid=Netcdf identifier.
1257 : : !! dimnames(:)=List of strings with the name of the dimensions
1258 : : !! values(:)=List of integer scalars
1259 : : !! [defmode]=If True, the nc file is set in define mode (default=False)
1260 : : !! [prefix]=Prefix added to varnames and dimensions. Empty string if not specified.
1261 : : !!
1262 : : !! SOURCE
1263 : :
1264 [ - + ]: 220638 : integer function nctk_def_dim_list(ncid, nctkdims, defmode, prefix) result(ncerr)
1265 : :
1266 : : !Arguments ------------------------------------
1267 : : !scalars
1268 : : integer,intent(in) :: ncid
1269 : : logical,optional,intent(in) :: defmode
1270 : : character(len=*),optional,intent(in) :: prefix
1271 : : !arrays
1272 : : type(nctkdim_t),intent(in) :: nctkdims(:)
1273 : :
1274 : : !Local variables-------------------------------
1275 : : integer :: ii
1276 : : ! *********************************************************************
1277 : :
1278 : 220638 : ncerr = nf90_noerr
1279 [ + + ]: 220638 : if (present(defmode)) then
1280 [ + - ]: 106498 : if (defmode) then
1281 [ - + ]: 106498 : NCF_CHECK(nctk_set_defmode(ncid))
1282 : : end if
1283 : : end if
1284 : :
1285 [ + + ]: 1547365 : do ii=1,size(nctkdims)
1286 [ + + ]: 1326727 : if (present(prefix)) then
1287 : 36 : ncerr = nctk_def_one_dim(ncid, nctkdims(ii), prefix=prefix)
1288 : : else
1289 : 1326691 : ncerr = nctk_def_one_dim(ncid, nctkdims(ii))
1290 : : end if
1291 [ - + ]: 1547365 : if (ncerr /= nf90_noerr) return
1292 : : end do
1293 : :
1294 : 220638 : end function nctk_def_dim_list
1295 : : !!***
1296 : :
1297 : : !----------------------------------------------------------------------
1298 : :
1299 : : !!****f* m_nctk/nctk_set_atomic_units
1300 : : !! NAME
1301 : : !! nctk_set_atomic_units
1302 : : !!
1303 : : !! FUNCTION
1304 : : !! Set the attributes "units" to "atomic units" and "scale_to_atomic_units" to one.
1305 : : !!
1306 : : !! INPUTS
1307 : : !! ncid=Netcdf identifier.
1308 : : !! varname=Name of the variable
1309 : : !!
1310 : : !! SOURCE
1311 : :
1312 : 98160 : integer function nctk_set_atomic_units(ncid, varname) result(ncerr)
1313 : :
1314 : : !Arguments ------------------------------------
1315 : : integer,intent(in) :: ncid
1316 : : character(len=*),intent(in) :: varname
1317 : :
1318 : : !Local variables-------------------------------
1319 : : integer :: varid
1320 : : ! *********************************************************************
1321 : :
1322 : 98160 : ncerr = nf90_noerr
1323 : :
1324 : 98160 : varid = nctk_idname(ncid, varname)
1325 [ - + ]: 98160 : NCF_CHECK(nf90_put_att(ncid, varid, "units", "atomic units"))
1326 [ - + ]: 98160 : NCF_CHECK(nf90_put_att(ncid, varid, "scale_to_atomic_units", one))
1327 : :
1328 : 98160 : end function nctk_set_atomic_units
1329 : : !!***
1330 : :
1331 : : !----------------------------------------------------------------------
1332 : :
1333 : : !!****f* m_nctk/nctk_def_basedims
1334 : : !! NAME
1335 : : !! nctk_def_basedims
1336 : : !!
1337 : : !! FUNCTION
1338 : : !! Define the basic dimensions used in ETSF-IO files.
1339 : : !!
1340 : : !! INPUTS
1341 : : !! ncid=Netcdf identifier.
1342 : : !! [defmode]=If True, the nc file is set in define mode (default=False)
1343 : : !!
1344 : : !! SOURCE
1345 : :
1346 : 34730 : integer function nctk_def_basedims(ncid, defmode) result(ncerr)
1347 : :
1348 : : !Arguments ------------------------------------
1349 : : integer,intent(in) :: ncid
1350 : : logical,optional,intent(in) :: defmode
1351 : : ! *********************************************************************
1352 : :
1353 : 34730 : ncerr = nf90_noerr
1354 : :
1355 [ + + ]: 34730 : if (present(defmode)) then
1356 [ + - ]: 32780 : if (defmode) then
1357 [ - + ]: 32780 : NCF_CHECK(nctk_set_defmode(ncid))
1358 : : end if
1359 : : end if
1360 : :
1361 : : ! Basic ETSF-IO dimensions that should be always present in the file.
1362 : : ncerr = nctk_def_dims(ncid, [&
1363 : : nctkdim_t("complex", 2), nctkdim_t("symbol_length", 2), nctkdim_t("character_string_length", etsfio_charlen),&
1364 : : nctkdim_t("number_of_cartesian_directions", 3), nctkdim_t("number_of_reduced_dimensions", 3),&
1365 : : nctkdim_t("number_of_vectors", 3) &
1366 [ + + ]: 243110 : ])
1367 [ - + ]: 34730 : NCF_CHECK(ncerr)
1368 : :
1369 : : ! Useful integers.
1370 : : ncerr = nctk_def_dims(ncid, [ &
1371 : : nctkdim_t("one", 1), nctkdim_t("two", 2), nctkdim_t("three", 3), &
1372 : : nctkdim_t("four", 4), nctkdim_t("five", 5), nctkdim_t("six", 6), &
1373 : : nctkdim_t("seven", 7), nctkdim_t("eight", 8), nctkdim_t("nine", 9), nctkdim_t("ten", 10), &
1374 : : nctkdim_t("fnlen", fnlen + 1) &
1375 [ + + ]: 416760 : ])
1376 [ - + ]: 34730 : NCF_CHECK(ncerr)
1377 : :
1378 : 34730 : end function nctk_def_basedims
1379 : : !!***
1380 : :
1381 : : !!****f* m_nctk/ab_define_var
1382 : : !!
1383 : : !! NAME
1384 : : !! ab_define_var
1385 : : !!
1386 : : !! FUNCTION
1387 : : !! Write the definition of a variable, including units and mnemonics
1388 : : !!
1389 : : !! INPUTS
1390 : : !! ncid = Identifier of the netcdf dataset
1391 : : !! var_dim_id = Identifier of the Dimensions
1392 : : !! var_id = Identifier of the variable
1393 : : !! var_mnemo = String of mnemonics
1394 : : !! var_name = String with the name of the variable
1395 : : !! var_type = NetCDF type of variable (NF90_DOUBLE, etc)
1396 : : !! var_units = String of units
1397 : : !!
1398 : : !! OUTPUT
1399 : : !! (only writing)
1400 : : !!
1401 : : !! SOURCE
1402 : :
1403 [ - + ]: 17317 : subroutine ab_define_var(ncid, var_dim_id, var_id, var_type, var_name, var_mnemo, var_units)
1404 : :
1405 : : !Arguments ------------------------------------
1406 : : !scalars
1407 : : integer, intent(in) :: ncid
1408 : : integer, intent(out) :: var_id
1409 : : character(len=*), intent(in) :: var_mnemo,var_units,var_name
1410 : : integer,intent(in) :: var_type
1411 : : !arrays
1412 : : integer,intent(in) :: var_dim_id(:)
1413 : :
1414 : : !Local variables-------------------------------
1415 : : integer :: ncerr
1416 : : ! *************************************************************************
1417 : :
1418 : 17317 : ncerr = nf90_def_var(ncid, trim(var_name), var_type, var_dim_id, var_id)
1419 [ - + - - ]: 17317 : NCF_CHECK_MSG(ncerr," define variable "//trim(var_name))
1420 : :
1421 : 17317 : ncerr = nf90_put_att(ncid, var_id, "units",trim(var_units))
1422 [ - + - - ]: 17317 : NCF_CHECK_MSG(ncerr," define attribute for "//trim(var_name))
1423 : :
1424 : 17317 : ncerr = nf90_put_att(ncid, var_id, "mnemonics", trim(var_mnemo))
1425 [ - + - - ]: 17317 : NCF_CHECK_MSG(ncerr," define attribute for "//trim(var_name))
1426 : :
1427 : 17317 : end subroutine ab_define_var
1428 : : !!***
1429 : :
1430 : : !!****f* m_nctk/nctk_def_scalars_type
1431 : : !! NAME
1432 : : !! nctk_def_scalars_type
1433 : : !!
1434 : : !! FUNCTION
1435 : : !! Define list of **scalar** variables with a given type, Return immediately if error
1436 : : !!
1437 : : !! INPUTS
1438 : : !! ncid=Netcdf identifier.
1439 : : !! varnames(:)=List of strings with the name of the variables
1440 : : !! xtype=Type of the variables
1441 : : !! [defmode]=If True, the nc file is set in define mode (default=False)
1442 : : !! [prefix]=Prefix added to varnames and dimensions. Empty string if not specified.
1443 : : !!
1444 : : !! SOURCE
1445 : :
1446 [ - + ]: 217374 : integer function nctk_def_scalars_type(ncid, varnames, xtype, defmode, prefix) result(ncerr)
1447 : :
1448 : : !Arguments ------------------------------------
1449 : : !scalars
1450 : : integer,intent(in) :: ncid,xtype
1451 : : logical,optional,intent(in) :: defmode
1452 : : character(len=*),optional,intent(in) :: prefix
1453 : : !arrays
1454 : : character(len=*),intent(in) :: varnames(:)
1455 : :
1456 : : !Local variables-------------------------------
1457 : : !scalars
1458 : : integer :: ii,varid
1459 : : character(len=nctk_slen) :: vname
1460 : : type(nctkvar_t) :: var
1461 : : ! *********************************************************************
1462 : :
1463 : 217374 : ncerr = nf90_noerr
1464 : 217374 : if (present(defmode)) then
1465 [ + - ]: 40069 : if (defmode) then
1466 [ - + ]: 40069 : NCF_CHECK(nctk_set_defmode(ncid))
1467 : : end if
1468 : : end if
1469 : :
1470 : : ! Special case where dimension is null
1471 [ + + ]: 1161661 : do ii=1,size(varnames)
1472 [ + + ]: 944287 : vname = varnames(ii)
1473 [ + + + - ]: 944287 : if (present(prefix)) vname = strcat(prefix, vname)
1474 : :
1475 [ + + ]: 1161661 : if (nf90_inq_varid(ncid, vname, varid) == nf90_noerr) then
1476 : : ! Variable already exists. Check if type and dimensions agree
1477 : 99617 : call var_from_id(ncid, varid, var)
1478 : :
1479 [ + - - + ]: 99617 : if (.not. (var%xtype == xtype .and. var%ndims == 0)) then
1480 : 0 : ABI_ERROR("variable already exists with a different definition.")
1481 : : else
1482 : : cycle ! Dimension matches, skip definition.
1483 : : end if
1484 : :
1485 : : else
1486 : : ! Define variable since it doesn't exist.
1487 : 844670 : ncerr = nf90_def_var(ncid, vname, xtype, varid)
1488 [ - + ]: 844670 : NCF_CHECK(ncerr)
1489 : : end if
1490 : : end do
1491 : :
1492 [ + + + + : 445399326 : end function nctk_def_scalars_type
+ + ]
1493 : : !!***
1494 : :
1495 : : !!****f* m_nctk/nctk_def_iscalars
1496 : : !! NAME
1497 : : !! nctk_def_iscalars
1498 : : !!
1499 : : !! FUNCTION
1500 : : !! Define list of integer **scalar** variables. Return immediately if error
1501 : : !!
1502 : : !! INPUTS
1503 : : !! ncid=Netcdf identifier.
1504 : : !! varnames(:)=List of strings with the name of the variables
1505 : : !! [defmode]=If True, the nc file is set in define mode (default=False)
1506 : : !! [prefix]=Prefix added to varnames and dimensions. Empty string if not specified.
1507 : : !!
1508 : : !! SOURCE
1509 : :
1510 [ - + ]: 112840 : integer function nctk_def_iscalars(ncid, varnames, defmode, prefix) result(ncerr)
1511 : :
1512 : : !Arguments ------------------------------------
1513 : : !scalars
1514 : : integer,intent(in) :: ncid
1515 : : logical,optional,intent(in) :: defmode
1516 : : character(len=*),optional,intent(in) :: prefix
1517 : : !arrays
1518 : : character(len=*),intent(in) :: varnames(:)
1519 : : ! *********************************************************************
1520 : :
1521 [ + + ]: 112840 : if (present(defmode)) then
1522 : 29093 : ncerr = nctk_def_scalars_type(ncid, varnames, nf90_int, defmode=defmode)
1523 : : else
1524 [ + + ]: 83747 : if (present(prefix)) then
1525 : 36 : ncerr = nctk_def_scalars_type(ncid, varnames, nf90_int, prefix=prefix)
1526 : : else
1527 : 83711 : ncerr = nctk_def_scalars_type(ncid, varnames, nf90_int)
1528 : : end if
1529 : : end if
1530 : :
1531 : 112840 : end function nctk_def_iscalars
1532 : : !!***
1533 : :
1534 : : !!****f* m_nctk/nctk_def_dpscalars
1535 : : !! NAME
1536 : : !! nctk_def_dpscalars
1537 : : !!
1538 : : !! FUNCTION
1539 : : !! Define list of double precision **scalar** variables. Return immediately if error
1540 : : !!
1541 : : !! INPUTS
1542 : : !! ncid=Netcdf identifier.
1543 : : !! varnames(:)=List of strings with the name of the variables
1544 : : !! [defmode]=If True, the nc file is set in define mode (default=False)
1545 : : !! [prefix]=Prefix added to varnames and dimensions. Empty string if not specified.
1546 : : !!
1547 : : !! SOURCE
1548 : :
1549 : 209068 : integer function nctk_def_dpscalars(ncid, varnames, defmode, prefix) result(ncerr)
1550 : :
1551 : : !Arguments ------------------------------------
1552 : : !scalars
1553 : : integer,intent(in) :: ncid
1554 : : logical,optional,intent(in) :: defmode
1555 : : character(len=*),optional,intent(in) :: prefix
1556 : : !arrays
1557 : : character(len=*),intent(in) :: varnames(:)
1558 : :
1559 : : !Local variables-------------------------------
1560 : : character(len=nctk_slen) :: prefix_
1561 : : ! *********************************************************************
1562 [ + + - + ]: 104534 : prefix_ = ""; if (present(prefix)) prefix_ = prefix
1563 : :
1564 [ + + ]: 104534 : if (present(defmode)) then
1565 : 10976 : ncerr = nctk_def_scalars_type(ncid, varnames, nf90_double, defmode=defmode, prefix=prefix_)
1566 : : else
1567 : 93558 : ncerr = nctk_def_scalars_type(ncid, varnames, nf90_double, prefix=prefix_)
1568 : : end if
1569 : :
1570 [ - + ]: 104534 : end function nctk_def_dpscalars
1571 : : !!***
1572 : :
1573 : : !!****f* m_nctk/nctk_def_one_array
1574 : : !! NAME
1575 : : !! nctk_def_one_array
1576 : : !!
1577 : : !! FUNCTION
1578 : : !! Define list of arrays with a given type, Return immediately if error
1579 : : !!
1580 : : !! INPUTS
1581 : : !! ncid=Netcdf identifier.
1582 : : !! nctk_array=Array descriptor.
1583 : : !! [defmode]=If True, the nc file is set in define mode (default=False)
1584 : : !! [prefix]=Prefix added to varnames and dimensions. Empty string if not specified.
1585 : : !!
1586 : : !! SOURCE
1587 : :
1588 : :
1589 : 1208208 : integer function nctk_def_one_array(ncid, nctk_array, defmode, varid, prefix) result(ncerr)
1590 : :
1591 : : !Arguments ------------------------------------
1592 : : !scalars
1593 : : integer,intent(in) :: ncid
1594 : : logical,optional,intent(in) :: defmode
1595 : : integer,optional,intent(out) :: varid
1596 : : type(nctkarr_t),intent(in) :: nctk_array
1597 : : character(len=*),optional,intent(in) :: prefix
1598 : :
1599 : : !Local variables-------------------------------
1600 : : !scalars
1601 : : integer :: ii,xtype,prev,cnt,nn,vid
1602 : : character(len=500) :: msg
1603 : : !arrays
1604 : : integer :: dimids(NF90_MAX_DIMS),dimvals(NF90_MAX_DIMS)
1605 : : character(len=nctk_slen) :: sarr(NF90_MAX_DIMS), string, pre, vname, dimname
1606 : : type(nctkvar_t) :: var
1607 : : ! *********************************************************************
1608 : :
1609 [ - + ]: 90 : pre = ""; if (present(prefix)) pre = prefix
1610 : :
1611 : 1208208 : ncerr = nf90_noerr
1612 [ - + ]: 1208208 : if (present(defmode)) then
1613 [ # # ]: 0 : if (defmode) then
1614 [ # # ]: 0 : NCF_CHECK(nctk_set_defmode(ncid))
1615 : : end if
1616 : : end if
1617 : :
1618 : 1208208 : xtype = str2xtype(nctk_array%dtype)
1619 [ + - ]: 1208208 : vname = strcat(pre, nctk_array%name)
1620 : :
1621 : : ! Build array of strings with the dimensions.
1622 : 1208208 : string = nctk_array%shape_str
1623 : 1208208 : nn = char_count(string, ",")
1624 [ - + ]: 1208208 : ABI_CHECK(nn <= NF90_MAX_DIMS, "Too many dimensions!")
1625 : :
1626 : : ! Parse dimension names and add prefix (if any).
1627 [ + + ]: 1208208 : if (nn == 0) then
1628 : 560891 : cnt = 1
1629 : 560891 : dimname = lstrip(string)
1630 [ + + + + : 6092116 : if (any(dimname == NCTK_IMPLICIT_DIMS)) then
+ + ]
1631 : 11001 : sarr(1) = dimname
1632 : : else
1633 [ + - ]: 549890 : sarr(1) = strcat(pre, dimname)
1634 : : end if
1635 : : else
1636 : 647317 : prev = 0; cnt = 0
1637 [ + + ]: 35034232 : do ii=1,len_trim(string)
1638 [ + + ]: 35034232 : if (string(ii:ii) == ",") then
1639 : 987744 : cnt = cnt + 1
1640 [ + - ]: 987744 : dimname = lstrip(string(prev+1:ii-1))
1641 [ + + + + : 10128654 : if (any(dimname == NCTK_IMPLICIT_DIMS)) then
+ + ]
1642 : 94189 : sarr(cnt) = dimname
1643 : : else
1644 [ + - ]: 893555 : sarr(cnt) = strcat(pre, dimname)
1645 : : end if
1646 : : prev = ii
1647 : : end if
1648 : : end do
1649 : 647317 : cnt = cnt + 1
1650 [ + - ]: 647317 : dimname = lstrip(string(prev+1:ii-1))
1651 [ + + + + : 7117576 : if (any(dimname == NCTK_IMPLICIT_DIMS)) then
+ + ]
1652 : 395 : sarr(cnt) = dimname
1653 : : else
1654 [ + - ]: 646922 : sarr(cnt) = strcat(pre, dimname)
1655 : : end if
1656 : : end if
1657 : :
1658 : : ! Get dimids
1659 [ + + ]: 3404160 : do ii=1,cnt
1660 [ - + ]: 2195952 : NCF_CHECK_MSG(nf90_inq_dimid(ncid, sarr(ii), dimids(ii)), sarr(ii))
1661 [ - + ]: 3404160 : NCF_CHECK(nf90_inquire_dimension(ncid, dimids(ii), len=dimvals(ii)))
1662 : : end do
1663 : :
1664 : : ! Check if dimension already exists.
1665 : : ! Variable already exists. Check if type and dimensions agree
1666 [ + + ]: 1208208 : if (nf90_inq_varid(ncid, vname, vid) == nf90_noerr) then
1667 : 226907 : call var_from_id(ncid, vid, var)
1668 [ + - - + ]: 226907 : if (.not. (var%xtype == xtype .and. var%ndims == cnt)) then
1669 : : write(msg,"(4a,2(2(a,i0),a))")&
1670 : 0 : "variable ",trim(vname)," already exists with a different definition:",ch10,&
1671 : 0 : "In file: xtype = ",var%xtype,", ndims = ",var%ndims,ch10,&
1672 : 0 : "From caller: xtype = ",xtype,", ndims = ",cnt,ch10
1673 : 0 : ABI_ERROR(msg)
1674 : : end if
1675 [ + + + - : 645018 : if (any(dimvals(1:cnt) /= var%dimlens(1:var%ndims))) then
- + ]
1676 : : write(msg,"(4a,2(3a))")&
1677 : 0 : "variable ",trim(vname)," already exists but with different shape.",ch10,&
1678 [ # # ]: 0 : "In file: dims = ",trim(ltoa(var%dimlens(:var%ndims))),ch10,&
1679 [ # # ]: 0 : "From caller dims = ",trim(ltoa(dimvals(:cnt))),ch10
1680 : 0 : ABI_ERROR(msg)
1681 : : end if
1682 [ - + ]: 226907 : if (present(varid)) varid = vid
1683 : 226907 : return
1684 : : end if
1685 : :
1686 : : ! Define variable since it doesn't exist.
1687 : 981301 : ncerr = nf90_def_var(ncid, vname, xtype, dimids(1:cnt), vid)
1688 [ - + ]: 981301 : NCF_CHECK(ncerr)
1689 : :
1690 [ + + ]: 981301 : if (present(varid)) varid = vid
1691 : :
1692 [ + + + + : 2476599493 : end function nctk_def_one_array
+ + ]
1693 : : !!***
1694 : :
1695 : : !!****f* m_nctk/nctk_def_array_list
1696 : : !! NAME
1697 : : !! nctk_def_array_list
1698 : : !!
1699 : : !! FUNCTION
1700 : : !! Define list of arrays with a given type, Return immediately if error
1701 : : !!
1702 : : !! INPUTS
1703 : : !! ncid=Netcdf identifier.
1704 : : !! nctk_arrays(:)=List of array descriptors.
1705 : : !! [defmode]=If True, the nc file is set in define mode (default=False)
1706 : : !! [prefix]=Prefix added to varnames and dimensions. Empty string if not specified.
1707 : : !!
1708 : : !! SOURCE
1709 : :
1710 : :
1711 [ - + ]: 249182 : integer function nctk_def_array_list(ncid, nctk_arrays, defmode, prefix) result(ncerr)
1712 : :
1713 : : !Arguments ------------------------------------
1714 : : !scalars
1715 : : integer,intent(in) :: ncid
1716 : : logical,optional,intent(in) :: defmode
1717 : : character(len=*),optional,intent(in) :: prefix
1718 : : !arrays
1719 : : type(nctkarr_t),intent(in) :: nctk_arrays(:)
1720 : :
1721 : : !Local variables-------------------------------
1722 : : integer :: ia
1723 : : ! *********************************************************************
1724 : :
1725 : 249182 : ncerr = nf90_noerr
1726 [ + + ]: 249182 : if (present(defmode)) then
1727 [ + - ]: 4400 : if (defmode) then
1728 [ - + ]: 4400 : NCF_CHECK(nctk_set_defmode(ncid))
1729 : : end if
1730 : : end if
1731 : :
1732 [ + + ]: 1343309 : do ia=1,size(nctk_arrays)
1733 [ + + ]: 1343309 : if (present(prefix)) then
1734 [ - + ]: 90 : NCF_CHECK(nctk_def_one_array(ncid, nctk_arrays(ia), prefix=prefix))
1735 : : else
1736 [ - + ]: 1094037 : NCF_CHECK(nctk_def_one_array(ncid, nctk_arrays(ia)))
1737 : : end if
1738 : : end do
1739 : :
1740 : 249182 : end function nctk_def_array_list
1741 : : !!***
1742 : :
1743 : : !!****f* m_nctk/nctk_write_iscalars
1744 : : !! NAME
1745 : : !! nctk_write_iscalars
1746 : : !!
1747 : : !! FUNCTION
1748 : : !! Write a list of **scalar** integer variables. Return immediately if error
1749 : : !!
1750 : : !! INPUTS
1751 : : !! ncid=Netcdf identifier.
1752 : : !! varnames(:)=List of strings with the name of the variables
1753 : : !! values(:)=List of integer scalars
1754 : : !! [datamode]=If True, the nc file is set in data mode (default=False)
1755 : : !!
1756 : : !! OUTPUT
1757 : : !! ncerr=Exit status
1758 : : !!
1759 : : !! SOURCE
1760 : :
1761 [ - + - + ]: 40972 : integer function nctk_write_iscalars(ncid, varnames, values, datamode) result(ncerr)
1762 : :
1763 : : !Arguments ------------------------------------
1764 : : !scalars
1765 : : integer,intent(in) :: ncid
1766 : : logical,optional,intent(in) :: datamode
1767 : : !arrays
1768 : : integer,intent(in) :: values(:)
1769 : : character(len=*),intent(in) :: varnames(:)
1770 : :
1771 : : !Local variables-------------------------------
1772 : : integer :: ii,varid
1773 : : ! *********************************************************************
1774 : :
1775 [ - + ]: 40972 : ABI_CHECK(size(varnames) == size(values), "Different size in varnames, values")
1776 : :
1777 : 40972 : ncerr = nf90_noerr
1778 [ + + ]: 40972 : if (present(datamode)) then
1779 [ + - ]: 14 : if (datamode) then
1780 [ - + ]: 14 : NCF_CHECK(nctk_set_datamode(ncid))
1781 : : end if
1782 : : end if
1783 : :
1784 [ + + ]: 246410 : do ii=1,size(varnames)
1785 [ - + ]: 205438 : NCF_CHECK_MSG(nf90_inq_varid(ncid, varnames(ii), varid), sjoin("Inquiring: ", varnames(ii)))
1786 [ - + ]: 246410 : NCF_CHECK(nf90_put_var(ncid, varid, values(ii)))
1787 : : end do
1788 : :
1789 : 40972 : end function nctk_write_iscalars
1790 : : !!***
1791 : :
1792 : : !!****f* m_nctk/nctk_write_dpscalars
1793 : : !! NAME
1794 : : !! nctk_write_dpscalars
1795 : : !!
1796 : : !! FUNCTION
1797 : : !! Write a list of **scalar** real(dp) variables. Return immediately if error
1798 : : !!
1799 : : !! INPUTS
1800 : : !! ncid=Netcdf identifier.
1801 : : !! varnames(:)=List of strings with the name of the variables
1802 : : !! values(:)=List of real(dp) scalars
1803 : : !! [datamode]=If True, the nc file is set in data mode (default=False)
1804 : : !!
1805 : : !! SOURCE
1806 : :
1807 [ - + - + ]: 37538 : integer function nctk_write_dpscalars(ncid, varnames, values, datamode) result(ncerr)
1808 : :
1809 : : !Arguments ------------------------------------
1810 : : !scalars
1811 : : integer,intent(in) :: ncid
1812 : : logical,optional,intent(in) :: datamode
1813 : : !arrays
1814 : : real(dp),intent(in) :: values(:)
1815 : : character(len=*),intent(in) :: varnames(:)
1816 : :
1817 : : !Local variables-------------------------------
1818 : : integer :: ii,varid
1819 : : ! *********************************************************************
1820 : :
1821 : 37538 : ncerr = nf90_noerr
1822 : :
1823 [ - + ]: 37538 : ABI_CHECK(size(varnames) == size(values), "Different size in varnames, values")
1824 : :
1825 [ + + ]: 37538 : if (present(datamode)) then
1826 [ + - ]: 4177 : if (datamode) then
1827 [ - + ]: 4177 : NCF_CHECK(nctk_set_datamode(ncid))
1828 : : end if
1829 : : end if
1830 : :
1831 [ + + ]: 271279 : do ii=1,size(varnames)
1832 [ - + ]: 233741 : NCF_CHECK(nf90_inq_varid(ncid, varnames(ii), varid))
1833 [ - + ]: 271279 : NCF_CHECK(nf90_put_var(ncid, varid, values(ii)))
1834 : : end do
1835 : :
1836 : 37538 : end function nctk_write_dpscalars
1837 : : !!***
1838 : :
1839 : : !!****f* m_nctk/nctk_defnwrite_ivars
1840 : : !! NAME
1841 : : !! nctk_defnwrite_ivars
1842 : : !!
1843 : : !! FUNCTION
1844 : : !! Define list of integer **scalar** variables and write their values.
1845 : : !! Return immediately if error
1846 : : !!
1847 : : !! INPUTS
1848 : : !! ncid=Netcdf identifier.
1849 : : !! varnames(:)=List of strings with the name of the variables
1850 : : !! values(:)=List of integer scalars
1851 : : !!
1852 : : !! SOURCE
1853 : :
1854 [ - + - + ]: 13679 : integer function nctk_defnwrite_ivars(ncid, varnames, values) result(ncerr)
1855 : :
1856 : : !Arguments ------------------------------------
1857 : : !scalars
1858 : : integer,intent(in) :: ncid
1859 : : !arrays
1860 : : integer,intent(in) :: values(:)
1861 : : character(len=*),intent(in) :: varnames(:)
1862 : :
1863 : : !Local variables-------------------------------
1864 : : !scalars
1865 : : integer :: ii,varid
1866 : : ! *********************************************************************
1867 : :
1868 [ - + ]: 13679 : ABI_CHECK(size(varnames) == size(values), "Different size in varnames, values")
1869 : :
1870 : 13679 : ncerr = nctk_def_iscalars(ncid, varnames, defmode=.True.)
1871 [ - + ]: 13679 : NCF_CHECK(ncerr)
1872 : :
1873 [ - + ]: 13679 : NCF_CHECK(nctk_set_datamode(ncid))
1874 [ + + ]: 39624 : do ii=1,size(varnames)
1875 : 25945 : varid = nctk_idname(ncid, varnames(ii))
1876 [ - + ]: 39624 : NCF_CHECK(nf90_put_var(ncid, varid, values(ii)))
1877 : : end do
1878 : :
1879 : 13679 : end function nctk_defnwrite_ivars
1880 : : !!***
1881 : :
1882 : : !!****f* m_nctk/nctk_defnwrite_dpvars
1883 : : !! NAME
1884 : : !! nctk_defnwrite_dpvars
1885 : : !!
1886 : : !! FUNCTION
1887 : : !! Define list of real(dp) **scalar** variables and write their values.
1888 : : !! Return immediately if error
1889 : : !!
1890 : : !! INPUTS
1891 : : !! ncid=Netcdf identifier.
1892 : : !! varnames(:)=List of strings with the name of the variables
1893 : : !! values(:)=List of integer scalars
1894 : : !!
1895 : : !! SOURCE
1896 : :
1897 [ - + - + ]: 10976 : integer function nctk_defnwrite_dpvars(ncid, varnames, values) result(ncerr)
1898 : :
1899 : : !Arguments ------------------------------------
1900 : : !scalars
1901 : : integer,intent(in) :: ncid
1902 : : !arrays
1903 : : real(dp),intent(in) :: values(:)
1904 : : character(len=*),intent(in) :: varnames(:)
1905 : :
1906 : : !Local variables-------------------------------
1907 : : !scalars
1908 : : integer :: ii,varid
1909 : : !arrays
1910 : : ! *********************************************************************
1911 : : ncerr = nf90_noerr
1912 : :
1913 [ - + ]: 10976 : ABI_CHECK(size(varnames) == size(values), "Different size in varnames, values")
1914 : :
1915 : 10976 : ncerr = nctk_def_dpscalars(ncid, varnames, defmode=.True.)
1916 [ - + ]: 10976 : NCF_CHECK(ncerr)
1917 : :
1918 [ - + ]: 10976 : NCF_CHECK(nctk_set_datamode(ncid))
1919 [ + + ]: 246197 : do ii=1,size(varnames)
1920 : : !write(std_out,*)varnames(ii)
1921 : 235221 : varid = nctk_idname(ncid, varnames(ii))
1922 [ - + ]: 246197 : NCF_CHECK(nf90_put_var(ncid, varid, values(ii)))
1923 : : end do
1924 : :
1925 : 10976 : end function nctk_defnwrite_dpvars
1926 : : !!***
1927 : :
1928 : : !!****f* m_nctk/nctk_write_ibz
1929 : : !! NAME
1930 : : !! nctk_write_ibz
1931 : : !!
1932 : : !! FUNCTION
1933 : : !! Write the list of the k-points in the IBZ with the corresponding weights in Netcdf format.
1934 : : !! Mainly used for passing data to AbiPy. This routine should be called by master only.
1935 : : !!
1936 : : !! INPUTS
1937 : : !! fname=File name
1938 : : !! kpoints(:,:)=List of k-points
1939 : : !! weights(:)=K-point weights
1940 : : !!
1941 : : !! OUTPUT
1942 : : !! ncerr=Exit status
1943 : : !!
1944 : : !! SOURCE
1945 : :
1946 [ # # # # ]: 0 : integer function nctk_write_ibz(fname, kpoints, weights) result(ncerr)
1947 : :
1948 : : !Arguments ------------------------------------
1949 : : !scalars
1950 : : character(len=*),intent(in) :: fname
1951 : : !arrays
1952 : : real(dp),intent(in) :: kpoints(:,:),weights(:)
1953 : :
1954 : : !Local variables-------------------------------
1955 : : integer :: nkpts,ncid
1956 : : ! *********************************************************************
1957 : :
1958 [ # # ]: 0 : ABI_CHECK(size(kpoints, dim=2) == size(weights), "size(kpoints, dim=2) != size(weights)")
1959 : 0 : nkpts = size(kpoints, dim=2)
1960 : :
1961 [ # # ]: 0 : NCF_CHECK_MSG(nctk_open_create(ncid, fname, xmpi_comm_self), sjoin("Creating:", fname))
1962 : :
1963 : : ncerr = nctk_def_dims(ncid, [ &
1964 [ # # ]: 0 : nctkdim_t("number_of_reduced_dimensions",3), nctkdim_t("number_of_kpoints", nkpts)], defmode=.True.)
1965 [ # # ]: 0 : NCF_CHECK(ncerr)
1966 : :
1967 : : ncerr = nctk_def_array_list(ncid, [&
1968 : : nctkarr_t('reduced_coordinates_of_kpoints', "dp", "number_of_reduced_dimensions, number_of_kpoints"),&
1969 [ # # ]: 0 : nctkarr_t('kpoint_weights', "dp", "number_of_kpoints")])
1970 : : NCF_CHECK(ncerr)
1971 : :
1972 [ # # ]: 0 : NCF_CHECK(nctk_set_datamode(ncid))
1973 : :
1974 : 0 : ncerr = nf90_put_var(ncid, nctk_idname(ncid, 'reduced_coordinates_of_kpoints'), kpoints)
1975 [ # # ]: 0 : NCF_CHECK(ncerr)
1976 : :
1977 [ # # ]: 0 : NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, 'kpoint_weights'), weights))
1978 : :
1979 [ # # ]: 0 : NCF_CHECK(nf90_close(ncid))
1980 : :
1981 : 0 : end function nctk_write_ibz
1982 : : !!***
1983 : :
1984 : : !!****f* m_nctk/nctk_get_dim
1985 : : !! NAME
1986 : : !! nctk_get_dim
1987 : : !!
1988 : : !! FUNCTION
1989 : : !! Get the value of a dimension from its name.
1990 : : !!
1991 : : !! INPUTS
1992 : : !! ncid=Netcdf identifier.
1993 : : !! dimname=Name of the dimension.
1994 : : !! [datamode]=If True, the nc file is set in data mode (default=False)
1995 : : !!
1996 : : !! OUTPUT
1997 : : !! dimlen=Value of the dimension.
1998 : : !!
1999 : : !! SOURCE
2000 : :
2001 : 312398 : integer function nctk_get_dim(ncid, dimname, dimlen, datamode) result(ncerr)
2002 : :
2003 : : !Arguments ------------------------------------
2004 : : !scalars
2005 : : integer,intent(in) :: ncid
2006 : : character(len=*),intent(in) :: dimname
2007 : : integer,intent(out) :: dimlen
2008 : : logical,optional,intent(in) :: datamode
2009 : :
2010 : : !Local variables-------------------------------
2011 : : integer :: dimid
2012 : : ! *********************************************************************
2013 : :
2014 : 312398 : ncerr = nf90_noerr
2015 : :
2016 [ + + ]: 312398 : if (present(datamode)) then
2017 [ + - ]: 2 : if (datamode) then
2018 [ - + ]: 2 : NCF_CHECK(nctk_set_datamode(ncid))
2019 : : end if
2020 : : end if
2021 : :
2022 : 312398 : ncerr = nf90_inq_dimid(ncid, dimname, dimid)
2023 [ + - ]: 312398 : if (ncerr == nf90_noerr) then
2024 : 312398 : ncerr = nf90_inquire_dimension(ncid, dimid, len=dimlen)
2025 : : end if
2026 : :
2027 : 312398 : end function nctk_get_dim
2028 : : !!***
2029 : :
2030 : : !----------------------------------------------------------------------
2031 : :
2032 : : !!****f* m_nctk/nctk_write_datar
2033 : : !! NAME
2034 : : !! nctk_write_datar
2035 : : !!
2036 : : !! FUNCTION
2037 : : !! Write an array in real space in netcdf format
2038 : : !!
2039 : : !! INPUTS
2040 : : !! path=Filename
2041 : : !! varname=Name of the variable to write.
2042 : : !! ngfft(18)=information about 3D FFT
2043 : : !! cplex=1 for real arrays (e.g. GS rhor), 2 for complex array.
2044 : : !! nfft=number of points in the real space FFT mesh treated by this MPI proc
2045 : : !! nspden=number of spin-density components
2046 : : !! comm_fft=MPI communicator (used only if MPI-FFT).
2047 : : !! fftn3_distrib(n3)=rank of the processors which own fft planes in 3rd dimension.
2048 : : !! ffti3_local(n3)=local index for 3d dimension
2049 : : !! datar(cplex*nfft,nspden)= array in real space.
2050 : : !! [action]
2051 : : !!
2052 : : !! OUTPUT
2053 : : !! Only writing
2054 : : !!
2055 : : !! SOURCE
2056 : :
2057 : 7696 : integer function nctk_write_datar(varname,path,ngfft,cplex,nfft,nspden,&
2058 : 7696 : comm_fft,fftn3_distrib,ffti3_local,datar,action) result(ncerr)
2059 : :
2060 : : !Arguments ------------------------------------
2061 : : !scalars
2062 : : integer,intent(in) :: cplex,nfft,nspden,comm_fft
2063 : : character(len=*),intent(in) :: path,varname
2064 : : character(len=*),optional,intent(in) :: action
2065 : : !arrays
2066 : : integer,intent(in) :: ngfft(18),fftn3_distrib(ngfft(3)),ffti3_local(ngfft(3))
2067 : : real(dp),target,intent(in) :: datar(cplex*nfft,nspden)
2068 : :
2069 : : !Local variables-------------------------------
2070 : : !scalars
2071 : : integer,parameter :: master=0
2072 : : integer :: ncid,varid,i3,nproc_fft,me_fft,i3_glob,n1,n2,n3,ispden,cmode
2073 : : logical :: ionode
2074 : : character(len=nctk_slen) :: cplex_name,my_action
2075 : : !character(len=500) :: msg
2076 : : !arrays
2077 : 7696 : real(dp),allocatable :: glob_datar(:,:)
2078 : : ! *************************************************************************
2079 : :
2080 : : ! FIXME: Default should be open but this enters into conflict with the abi_estf stuff!
2081 : : ! if we are using MPI-IO since file is not open with HDF5.
2082 : : !my_action = "create"; if (present(action)) my_action = action
2083 [ + - ]: 7696 : my_action = "open"; if (present(action)) my_action = action
2084 : :
2085 : 7696 : nproc_fft = xmpi_comm_size(comm_fft); me_fft = xmpi_comm_rank(comm_fft)
2086 : 7696 : n1 = ngfft(1); n2 = ngfft(2); n3 = ngfft(3)
2087 : :
2088 : : ! TODO: Be careful here because we should always create with HDF5 if available
2089 : : ! to avoid problems if we have to reread with nproc_fft > 1 and MPI-IO
2090 : 7696 : ionode = .True.; ncerr = nf90_noerr
2091 [ + + ]: 7696 : if (nproc_fft == 1) then
2092 : 0 : select case(my_action)
2093 : : case ("open")
2094 : 0 : ncerr = nf90_open(path, mode=nf90_write, ncid=ncid)
2095 : : case ("create")
2096 : 7436 : ncerr = nctk_open_create(ncid, path, comm_fft)
2097 : : case default
2098 [ - + - ]: 7436 : ABI_ERROR(sjoin("Wrong action: ", my_action))
2099 : : end select
2100 : :
2101 : : else
2102 [ + - ]: 260 : if (nctk_has_mpiio) then
2103 : 260 : call wrtout(std_out, strcat("nctk_write_datar: using MPI-IO to write ", varname, path), "COLL")
2104 : :
2105 : 260 : ncerr = nf90_einval
2106 : : #ifdef HAVE_NETCDF_MPI
2107 : 0 : select case(my_action)
2108 : : case ("open")
2109 : 0 : ncerr = nf90_open(path, mode=nf90_write, comm=comm_fft, info=xmpio_info, ncid=ncid)
2110 : : case ("create")
2111 : : ncerr = nf90_create(path, cmode=ior(ior(nf90_netcdf4, nf90_mpiio), nf90_write), &
2112 : 260 : comm=comm_fft, info=xmpio_info, ncid=ncid)
2113 : : case default
2114 [ - + - ]: 260 : ABI_ERROR(strcat("Wrong action:", my_action))
2115 : : end select
2116 : : #endif
2117 : : else
2118 : : ! MPI-FFT without MPI-support. Only master performs IO
2119 : 0 : ionode = (me_fft == master)
2120 [ # # ]: 0 : if (ionode) then
2121 : 0 : select case(my_action)
2122 : : case ("open")
2123 : 0 : ncerr = nf90_open(path, mode=nf90_write, ncid=ncid)
2124 : : case ("create")
2125 : : !ncerr = nf90_create(path, cmode=nf90_clobber, ncid=ncid)
2126 : 0 : cmode = def_cmode_for_seq_create
2127 : 0 : ncerr = nf90_create(path, cmode=cmode, ncid=ncid)
2128 : : case default
2129 [ # # # ]: 0 : ABI_ERROR(strcat("Wrong action:", my_action))
2130 : : end select
2131 : : end if
2132 : : end if
2133 : : end if
2134 [ - + ]: 7696 : NCF_CHECK_MSG(ncerr, sjoin("opening file:", path))
2135 : :
2136 [ + - ]: 7696 : if (ionode) then
2137 : : ! Define dims and variables
2138 : : !write(std_out,*)"defing dims",trim(varname)," in file: ",path
2139 [ + - ]: 7696 : cplex_name = strcat("real_or_complex_", varname)
2140 : : ncerr = nctk_def_dims(ncid, [&
2141 : : nctkdim_t(cplex_name, cplex),&
2142 : : nctkdim_t("number_of_grid_points_vector1", n1),&
2143 : : nctkdim_t("number_of_grid_points_vector2", n2),&
2144 : : nctkdim_t("number_of_grid_points_vector3", n3),&
2145 [ + + ]: 46176 : nctkdim_t("number_of_components", nspden)], defmode=.True.)
2146 [ - + ]: 7696 : NCF_CHECK(ncerr)
2147 : :
2148 : : ncerr = nctk_def_one_array(ncid, nctkarr_t(name=varname, dtype="dp", shape_str=strcat(cplex_name, &
2149 : : ", number_of_grid_points_vector1, number_of_grid_points_vector2, number_of_grid_points_vector3, number_of_components")),&
2150 [ + + + - ]: 7696 : varid=varid)
2151 : :
2152 : : ! Add attributes
2153 : 7696 : varid = nctk_idname(ncid, varname)
2154 [ - + ]: 7696 : NCF_CHECK(nf90_put_att(ncid, varid, "units", "atomic units"))
2155 [ - + ]: 7696 : NCF_CHECK(nf90_put_att(ncid, varid, "scale_to_atomic_units", one))
2156 : : end if
2157 : :
2158 [ + + ]: 7696 : if (nproc_fft == 1) then
2159 : : ! no MPI-FFT --> write data directly.
2160 : 7436 : varid = nctk_idname(ncid, varname)
2161 [ - + ]: 7436 : NCF_CHECK(nctk_set_datamode(ncid))
2162 [ + + - + : 44616 : NCF_CHECK(nf90_put_var(ncid, varid, datar, start=[1,1,1,1,1], count=[cplex, n1, n2, n3, nspden]))
- - ]
2163 [ - + ]: 7436 : NCF_CHECK(nf90_close(ncid))
2164 : :
2165 : : else
2166 : : ! Must handle data distribution.
2167 [ - + ]: 260 : ABI_CHECK(mod(n3, nproc_fft) == 0, "assuming mod(n3, nproc_fft) == 0")
2168 : :
2169 : 260 : i3_glob = -1
2170 [ + - ]: 2866 : do i3=1,ngfft(3)
2171 [ + + ]: 2866 : if (fftn3_distrib(i3) == me_fft) then
2172 : : i3_glob = i3
2173 : : exit
2174 : : end if
2175 : : end do
2176 [ - + ]: 260 : ABI_CHECK(i3_glob > 0, "negative i3_glob")
2177 : :
2178 : : !do i3=i3_glob,ngfft(3)
2179 : : ! if (fftn3_distrib(i3) /= me_fft) exit
2180 : : ! !assert all(ffn3_distrib(i3_glob:i3_glob -1 + ngfft(3) / nproc_fft) == me_fft)
2181 : : !end do
2182 : : !i3_glob = i3- 1
2183 : : !print*,"i3_glob",i3_glob
2184 : :
2185 [ + - ]: 260 : if (ionode) then
2186 [ - + ]: 260 : NCF_CHECK(nf90_enddef(ncid))
2187 : : end if
2188 : :
2189 : : ! Array on disk has shape [cplex, n1, n2, n3, nspden]
2190 [ + - ]: 260 : if (nctk_has_mpiio) then
2191 : : ! Use collective IO.
2192 : 260 : ncerr = nf90_einval
2193 [ - + ]: 260 : NCF_CHECK(nctk_set_collective(ncid, varid))
2194 : :
2195 [ + + ]: 522 : do ispden=1,nspden
2196 : : ncerr = nf90_put_var(ncid, varid, datar(:,ispden), start=[1,1,1,i3_glob,ispden], &
2197 [ + + + + ]: 2882 : count=[cplex,n1,n2,n3/nproc_fft,1])
2198 [ - + ]: 522 : NCF_CHECK(ncerr)
2199 : : end do
2200 : : else
2201 : : ! MPI-FFT without MPI-IO. Collect data (requires more memory and communication)
2202 [ # # # # : 0 : ABI_MALLOC(glob_datar, (cplex*product(ngfft(1:3)), nspden))
# # # # #
# # # # #
# # # # #
# ]
2203 : 0 : call collect_datar(ngfft,cplex,nfft,nspden,datar,comm_fft,fftn3_distrib,ffti3_local,glob_datar,master=master)
2204 : :
2205 [ # # ]: 0 : if (ionode) then
2206 : : ! Write global array.
2207 [ # # # # : 0 : NCF_CHECK(nf90_put_var(ncid, varid, glob_datar, start=[1,1,1,1,1], count=[cplex,n1,n2,n3,nspden]))
# # ]
2208 : : end if
2209 [ # # ]: 0 : ABI_FREE(glob_datar)
2210 : : end if
2211 : :
2212 [ + - ]: 260 : if (ionode) then
2213 [ - + ]: 260 : NCF_CHECK(nf90_close(ncid))
2214 : : end if
2215 : : end if
2216 : :
2217 : : !ok = .True.
2218 : : ! Sequential IO
2219 : : !do rank=0,nproc_fft-1
2220 : : ! if (rank == me_fft) then
2221 : : ! ncerr = nf90_open(path, mode=nf90_write, ncid=ncid)
2222 : : ! do ispden=1,nspden
2223 : : ! ncerr = nf90_put_var(ncid, varid, datar(1:,ispden), start=[1,1,1,i3_glob,ispden], &
2224 : : ! count=[cplex,ngfft(1),ngfft(2),ngfft(3)/nproc_fft,1])
2225 : : ! end do
2226 : : ! ncerr = nf90_close(ncid)
2227 : : ! end if
2228 : : ! call xmpi_barrier(comm_fft)
2229 : : !end do
2230 : :
2231 [ + - - + ]: 15392 : end function nctk_write_datar
2232 : : !!***
2233 : :
2234 : : !!****f* m_nctk/nctk_read_datar
2235 : : !! NAME
2236 : : !! nctk_read_datar
2237 : : !!
2238 : : !! FUNCTION
2239 : : !! Read an array in real space in netcdf format
2240 : : !!
2241 : : !! INPUTS
2242 : : !! path=Filename
2243 : : !! varname=Name of the variable to read.
2244 : : !! ngfft(18)=information about 3D FFT
2245 : : !! cplex=1 for real arrays (e.g. GS rhor), 2 for complex array.
2246 : : !! nfft=number of points in the real space FFT mesh treated by this MPI proc
2247 : : !! nspden=number of spin-density components
2248 : : !! comm_fft=MPI communicator (used only if MPI-FFT).
2249 : : !! fftn3_distrib(n3)=rank of the processors which own fft planes in 3rd dimension.
2250 : : !! ffti3_local(n3)=local index for 3d dimension
2251 : : !! datar(cplex*nfft,nspden)= array in real space.
2252 : : !!
2253 : : !! OUTPUT
2254 : : !! Only writing
2255 : : !!
2256 : : !! SOURCE
2257 : :
2258 : 0 : integer function nctk_read_datar(path,varname,ngfft,cplex,nfft,nspden,&
2259 : 0 : comm_fft,fftn3_distrib,ffti3_local,datar) result(ncerr)
2260 : :
2261 : : !Arguments ------------------------------------
2262 : : !scalars
2263 : : integer,intent(in) :: cplex,nfft,nspden,comm_fft
2264 : : character(len=*),intent(in) :: path,varname
2265 : : !arrays
2266 : : integer,intent(in) :: ngfft(18),fftn3_distrib(ngfft(3)),ffti3_local(ngfft(3))
2267 : : real(dp),intent(out) :: datar(cplex*nfft,nspden)
2268 : :
2269 : : !Local variables-------------------------------
2270 : : !scalars
2271 : : integer,parameter :: master=0
2272 : : integer :: ncid,varid,i3,nproc_fft,me_fft,i3_glob,n1,n2,n3,ispden
2273 : : logical :: ionode
2274 : : !arrays
2275 : 0 : real(dp),allocatable :: glob_datar(:,:)
2276 : : ! *************************************************************************
2277 : :
2278 : 0 : nproc_fft = xmpi_comm_size(comm_fft); me_fft = xmpi_comm_rank(comm_fft)
2279 : 0 : n1 = ngfft(1); n2 = ngfft(2); n3 = ngfft(3)
2280 : :
2281 : : ! TODO: Be careful here because we should always create with HDF5 if available
2282 : : ! to avoid problems if we have to reread with nproc_fft > 1 and MPI-IO
2283 : 0 : ionode = .True.
2284 [ # # ]: 0 : if (nproc_fft == 1) then
2285 : 0 : ncerr = nf90_open(path, mode=nf90_nowrite, ncid=ncid)
2286 : : else
2287 [ # # ]: 0 : if (nctk_has_mpiio) then
2288 : : !write(std_out,*)"open_par: ",trim(path)
2289 : : !ncerr = nf90_open_par(path, nf90_nowrite,
2290 : : ! Don't know why but the format is not autodected!
2291 : : ncerr = nf90_einval
2292 : : #ifdef HAVE_NETCDF_MPI
2293 : : ncerr = nf90_open(path, mode=ior(ior(nf90_netcdf4, nf90_mpiio), nf90_nowrite),&
2294 : 0 : comm=comm_fft, info=xmpio_info, ncid=ncid)
2295 : : #endif
2296 : : else
2297 : : ! MPI-FFT without MPI-support. Only master does IO
2298 : 0 : ionode = (me_fft == master); ncerr = nf90_noerr
2299 [ # # ]: 0 : if (ionode) ncerr = nf90_open(path, nf90_nowrite, ncid)
2300 : : end if
2301 : : end if
2302 [ # # ]: 0 : NCF_CHECK_MSG(ncerr, sjoin("opening file: ",path))
2303 : :
2304 [ # # ]: 0 : NCF_CHECK(nf90_inq_varid(ncid, varname, varid))
2305 : : !write(std_out,*)"about to read varname, ngfft, cplex, nfft, nspden:", trim(varname), ngfft(:3), cplex,nfft,nspden
2306 : :
2307 : : ! netcdf array has shape [cplex, n1, n2, n3, nspden]
2308 [ # # ]: 0 : if (nproc_fft == 1) then
2309 : : ! No MPI-FFT --> easy
2310 [ # # # # : 0 : NCF_CHECK(nf90_get_var(ncid, varid, datar, start=[1,1,1,1], count=[cplex, n1, n2, n3, nspden]))
# # ]
2311 [ # # ]: 0 : NCF_CHECK(nf90_close(ncid))
2312 : :
2313 : : else
2314 : : ! Handle data distribution.
2315 [ # # ]: 0 : ABI_CHECK(mod(ngfft(3), nproc_fft) == 0, "assuming mod(n3, nproc_fft) == 0")
2316 : :
2317 : 0 : i3_glob = -1
2318 [ # # ]: 0 : do i3=1,ngfft(3)
2319 [ # # ]: 0 : if (fftn3_distrib(i3) == me_fft) then
2320 : : i3_glob = i3
2321 : : exit
2322 : : end if
2323 : : end do
2324 [ # # ]: 0 : ABI_CHECK(i3_glob > 0, "negative i3_glob")
2325 : :
2326 [ # # ]: 0 : if (nctk_has_mpiio) then
2327 : : ! Use parallel IO with collective calls.
2328 : 0 : ncerr = nf90_einval
2329 [ # # ]: 0 : NCF_CHECK(nctk_set_collective(ncid, varid))
2330 : :
2331 [ # # ]: 0 : do ispden=1,nspden
2332 : : ncerr = nf90_get_var(ncid, varid, datar(:,ispden), start=[1,1,1,i3_glob,ispden], &
2333 [ # # # # ]: 0 : count=[cplex,ngfft(1),ngfft(2),ngfft(3)/nproc_fft,1])
2334 [ # # ]: 0 : NCF_CHECK(ncerr)
2335 : : end do
2336 : : else
2337 : : ! MPI-FFT without MPI-IO. Master read and broadcast (requires more memory and communication)
2338 [ # # # # : 0 : ABI_MALLOC(glob_datar, (cplex*product(ngfft(1:3)), nspden))
# # # # #
# # # # #
# # # # ]
2339 [ # # ]: 0 : if (ionode) then
2340 [ # # # # : 0 : NCF_CHECK(nf90_get_var(ncid, varid, glob_datar, start=[1,1,1,1,1], count=[cplex,n1,n2,n3,nspden]))
# # ]
2341 : : end if
2342 : :
2343 : 0 : call distrib_datar(ngfft,cplex,nfft,nspden,glob_datar,master,comm_fft,fftn3_distrib,ffti3_local,datar)
2344 [ # # ]: 0 : ABI_FREE(glob_datar)
2345 : : end if
2346 : :
2347 [ # # ]: 0 : if (ionode) then
2348 [ # # ]: 0 : NCF_CHECK(nf90_close(ncid))
2349 : : end if
2350 : : end if
2351 : :
2352 [ # # ]: 0 : end function nctk_read_datar
2353 : : !!***
2354 : :
2355 : : !!****f* m_nctk/nctk_prepare_mpiio
2356 : : !! NAME
2357 : : !! nctk_mpiio
2358 : : !!
2359 : : !! FUNCTION
2360 : : !! This function appears to be required to prevent deadlocks during I/O operations in single mode.
2361 : : !! Although single mode is the default, on some architectures or compilers, nf90_put_var
2362 : : !! can deadlock if not all processors in the communicator invoke the function.
2363 : : !! This solution was proposed by Hsiao-Yi Tsai.
2364 : :
2365 : 24 : integer function nctk_prepare_mpiio(ncid, varname) result(ncerr)
2366 : :
2367 : : !Arguments ------------------------------------
2368 : : integer,intent(in) :: ncid
2369 : : character(len=*),intent(in) :: varname
2370 : :
2371 : : !Local variables-------------------------------
2372 : : integer :: vid
2373 : : character(len=nctk_slen) :: out_varname
2374 : : ! *************************************************************************
2375 : :
2376 : 24 : vid = nctk_idname(ncid, varname)
2377 : 24 : ncerr = nf90_inquire_variable(ncid, vid, out_varname)
2378 : :
2379 : 24 : end function nctk_prepare_mpiio
2380 : : !!***
2381 : :
2382 : : !----------------------------------------------------------------------
2383 : :
2384 : : !!****f* m_nctk/collect_datar
2385 : : !! NAME
2386 : : !! collect_datar
2387 : : !!
2388 : : !! FUNCTION
2389 : : !! Collect a real-space MPI-FFT distributed array on each proc.
2390 : : !!
2391 : : !! INPUTS
2392 : : !! ngfft(18)=contain all needed information about 3D FFT (see NOTES at beginning of scfcv)
2393 : : !! cplex=1 if real array, 2 for complex
2394 : : !! nfft=Number of FFT points treated by this MPI proc
2395 : : !! nspden=Second dimension of rhor
2396 : : !! rhor(cplex*nfft,nspden)=Array in real space (MPI-FFT distributed)
2397 : : !! fftn3_distrib(n3)=rank of the processors which own fft planes in 3rd dimension.
2398 : : !! fftn3_local(n3)=local i3 indices
2399 : : !! comm_fft=MPI-FFT communicator
2400 : : !! [master]=MPI rank, Optional. If present, the global array is available only on master node.
2401 : : !!
2402 : : !! OUTPUT
2403 : : !! rhor_glob(cplex*nfft_tot,nspden)=Global array
2404 : : !!
2405 : : !! SOURCE
2406 : :
2407 [ # # ]: 0 : subroutine collect_datar(ngfft,cplex,nfft,nspden,rhor,comm_fft,fftn3_distrib,ffti3_local,rhor_glob,master)
2408 : :
2409 : : !Arguments ------------------------------------
2410 : : !scalars
2411 : : integer,intent(in) :: cplex,nfft,nspden,comm_fft
2412 : : integer,optional,intent(in) :: master
2413 : : !arrays
2414 : : integer,intent(in) :: ngfft(18)
2415 : : integer,intent(in) :: fftn3_distrib(ngfft(3)),ffti3_local(ngfft(3))
2416 : : real(dp),intent(in) :: rhor(cplex*nfft,nspden)
2417 : : real(dp),intent(out) :: rhor_glob(cplex*product(ngfft(1:3)),nspden)
2418 : :
2419 : : !Local variables-------------------------------
2420 : : integer :: ispden,i1,i2,i3,me_fft,i3_local,my_fftbase,glob_fftbase
2421 : : integer :: n1,n2,n3,ierr,nfft_tot
2422 : : ! *************************************************************************
2423 : :
2424 [ # # ]: 0 : nfft_tot = product(ngfft(1:3)); me_fft = xmpi_comm_rank(comm_fft)
2425 : 0 : n1 = ngfft(1); n2 = ngfft(2); n3 = ngfft(3)
2426 : :
2427 [ # # ]: 0 : if (nfft_tot == nfft) then
2428 : : ! full rhor on each node, just do a copy
2429 [ # # # # ]: 0 : rhor_glob = rhor
2430 : : else
2431 : : ! if MPI-FFT we have to gather the global array on each node.
2432 [ # # # # ]: 0 : rhor_glob = zero
2433 [ # # ]: 0 : do ispden=1,nspden
2434 [ # # ]: 0 : do i3=1,n3
2435 [ # # ]: 0 : if (me_fft == fftn3_distrib(i3)) then
2436 : 0 : i3_local = ffti3_local(i3)
2437 [ # # ]: 0 : do i2=1,n2
2438 : 0 : my_fftbase = cplex * ( (i2-1)*n1 + (i3_local-1)*n1*n2 )
2439 : 0 : glob_fftbase = cplex * ( (i2-1)*n1 + (i3-1)*n1*n2 )
2440 [ # # ]: 0 : do i1=1,cplex * n1
2441 : 0 : rhor_glob(i1+glob_fftbase,ispden) = rhor(i1+my_fftbase,ispden)
2442 : : end do
2443 : : end do
2444 : : end if
2445 : : end do
2446 : : end do
2447 [ # # ]: 0 : if (present(master)) then
2448 : 0 : call xmpi_sum_master(rhor_glob,master,comm_fft,ierr)
2449 : : else
2450 : 0 : call xmpi_sum(rhor_glob,comm_fft,ierr)
2451 : : end if
2452 : : end if
2453 : :
2454 : 0 : end subroutine collect_datar
2455 : : !!***
2456 : :
2457 : : !----------------------------------------------------------------------
2458 : :
2459 : : !!****f* m_nctk/distrib_datar
2460 : : !! NAME
2461 : : !! distrib_datar
2462 : : !!
2463 : : !! FUNCTION
2464 : : !! distribute a real-space MPI-FFT
2465 : : !!
2466 : : !! INPUTS
2467 : : !! ngfft(18)=contain all needed information about 3D FFT (see NOTES at beginning of scfcv)
2468 : : !! cplex=1 if real array, 2 for complex
2469 : : !! nfft=Number of FFT points treated by this MPI proc
2470 : : !! nspden=Second dimension of rhor
2471 : : !! rhor_glob(cplex*nfft_tot,nspden)=Global array
2472 : : !! master=The rank of the node that owns the global array.
2473 : : !! comm_fft=MPI-FFT communicator
2474 : : !! fftn3_distrib(n3)=rank of the processors which own fft planes in 3rd dimension.
2475 : : !! fftn3_local(n3)=local i3 indices
2476 : : !!
2477 : : !! OUTPUT
2478 : : !! rhor(cplex*nfft,nspden)=Array in real space (MPI-FFT distributed)
2479 : : !!
2480 : : !! SOURCE
2481 : :
2482 [ # # ]: 0 : subroutine distrib_datar(ngfft,cplex,nfft,nspden,rhor_glob,master,comm_fft,fftn3_distrib,ffti3_local,rhor)
2483 : :
2484 : : !Arguments ------------------------------------
2485 : : !scalars
2486 : : integer,intent(in) :: cplex,nfft,nspden,comm_fft,master
2487 : : !arrays
2488 : : integer,intent(in) :: ngfft(18)
2489 : : integer,intent(in) :: fftn3_distrib(ngfft(3)),ffti3_local(ngfft(3))
2490 : : real(dp),intent(out) :: rhor(cplex*nfft,nspden)
2491 : : real(dp),intent(inout) :: rhor_glob(cplex*product(ngfft(1:3)),nspden)
2492 : :
2493 : : !Local variables-------------------------------
2494 : : integer :: ispden,i1,i2,i3,me_fft,i3_local,my_fftbase,glob_fftbase
2495 : : integer :: n1,n2,n3,ierr,nfft_tot
2496 : : ! *************************************************************************
2497 : :
2498 [ # # ]: 0 : nfft_tot = product(ngfft(1:3)); me_fft = xmpi_comm_rank(comm_fft)
2499 : 0 : n1 = ngfft(1); n2 = ngfft(2); n3 = ngfft(3)
2500 : :
2501 [ # # ]: 0 : if (nfft_tot == nfft) then
2502 : : ! full rhor on each node, just do a copy
2503 [ # # # # ]: 0 : rhor = rhor_glob
2504 : : else
2505 : : ! if MPI-FFT we have to gather the global array on each node.
2506 : 0 : call xmpi_bcast(rhor_glob,master,comm_fft,ierr)
2507 [ # # ]: 0 : do ispden=1,nspden
2508 [ # # ]: 0 : do i3=1,n3
2509 [ # # ]: 0 : if (me_fft == fftn3_distrib(i3)) then
2510 : 0 : i3_local = ffti3_local(i3)
2511 [ # # ]: 0 : do i2=1,n2
2512 : 0 : my_fftbase = cplex * ( (i2-1)*n1 + (i3_local-1)*n1*n2 )
2513 : 0 : glob_fftbase = cplex * ( (i2-1)*n1 + (i3-1)*n1*n2 )
2514 [ # # ]: 0 : do i1=1,cplex * n1
2515 : 0 : rhor(i1+my_fftbase,ispden) = rhor_glob(i1+glob_fftbase,ispden)
2516 : : end do
2517 : : end do
2518 : : end if
2519 : : end do
2520 : : end do
2521 : : end if
2522 : :
2523 : 0 : end subroutine distrib_datar
2524 : : !!***
2525 : :
2526 : : !----------------------------------------------------------------------
2527 : :
2528 : : !!****f* m_nctk/var_from_id
2529 : : !! NAME
2530 : : !! var_from_id
2531 : : !!
2532 : : !! FUNCTION
2533 : : !! Initialize a nctkvar_t object from the variable id
2534 : : !!
2535 : : !! INPUTS
2536 : : !! ncid=NC file handle
2537 : : !! varid=Variable ID
2538 : : !!
2539 : : !! OUTPUT
2540 : : !! var<nctkvar_t>=Info on the variable.
2541 : : !!
2542 : : !! SOURCE
2543 : :
2544 [ + + + + ]: 669374200 : subroutine var_from_id(ncid, varid, var)
2545 : :
2546 : : !Arguments ------------------------------------
2547 : : integer, intent(in) :: ncid, varid
2548 : : type(nctkvar_t), intent(out) :: var
2549 : :
2550 : : !Local variables-------------------------------
2551 : : !scalars
2552 : : integer :: ii, ncerr
2553 : : !character(len=NF90_MAX_NAME) :: ncname
2554 : : ! *********************************************************************
2555 : :
2556 : : ! Get info about the variable.
2557 : 326524 : var%id = varid
2558 : : ncerr = nf90_inquire_variable(ncid, var%id, &
2559 : 326524 : name=var%name, xtype=var%xtype, ndims=var%ndims, dimids=var%dimids, natts=var%natts)
2560 [ - + ]: 326524 : NCF_CHECK(ncerr)
2561 : :
2562 : : ! Get info about dimensions.
2563 [ + + ]: 326524 : if (var%ndims > 0) then
2564 [ + + ]: 645018 : do ii=1,var%ndims
2565 : 418111 : ncerr = nf90_inquire_dimension(ncid, var%dimids(ii), len=var%dimlens(ii), name=var%dimnames(ii))
2566 [ - + ]: 645018 : NCF_CHECK(ncerr)
2567 : : end do
2568 : : end if
2569 : :
2570 : : ! Get the number of attributes and their names.
2571 : : !if (var%natts > 0) then
2572 : : ! do ii=1,var%natts
2573 : : ! ncerr = nf90_inq_attname(ncid, var%id, ii, var%attnames(ii))
2574 : : ! end do
2575 : : !end if
2576 : :
2577 : 326524 : end subroutine var_from_id
2578 : : !!***
2579 : :
2580 : : !----------------------------------------------------------------------
2581 : :
2582 : : !!****f* m_nctk/var_from_name
2583 : : !! NAME
2584 : : !! var_from_name
2585 : : !!
2586 : : !! FUNCTION
2587 : : !! Initialize a nctkvar_t object from the variable name
2588 : : !!
2589 : : !! INPUTS
2590 : : !! ncid=NC file handle
2591 : : !! name=Variable name
2592 : : !!
2593 : : !! OUTPUT
2594 : : !! var<nctkvar_t>=Info on the variable.
2595 : : !!
2596 : : !! SOURCE
2597 : :
2598 : : subroutine var_from_name(ncid, name, var)
2599 : :
2600 : : !Arguments ------------------------------------
2601 : : integer, intent(in) :: ncid
2602 : : character(len=*),intent(in) :: name
2603 : : type(nctkvar_t), intent(out) :: var
2604 : :
2605 : : !Local variables-------------------------------
2606 : : !scalars
2607 : : integer :: varid
2608 : : ! *********************************************************************
2609 : :
2610 : : varid = nctk_idname(ncid, name)
2611 : : call var_from_id(ncid, varid, var)
2612 : :
2613 : : end subroutine var_from_name
2614 : : !!***
2615 : :
2616 : : !!****f* m_nctk/create_nc_file
2617 : : !! NAME
2618 : : !! create_nc_file
2619 : : !!
2620 : : !! FUNCTION
2621 : : !! Create an NetCDF file including a dimension one definition
2622 : : !!
2623 : : !! INPUTS
2624 : : !!
2625 : : !! OUTPUT
2626 : : !!
2627 : : !! TODO:
2628 : : !! Remove
2629 : : !!
2630 : : !! SOURCE
2631 : :
2632 : 4202 : subroutine create_nc_file(filename, ncid)
2633 : :
2634 : : !Arguments ------------------------------------
2635 : : !scalars
2636 : : integer,intent(out) :: ncid
2637 : : !arrays
2638 : : character(len=*),intent(in) :: filename
2639 : :
2640 : : !Local variables-------------------------------
2641 : : integer :: one_id, ncerr, cmode
2642 : : ! *************************************************************************
2643 : :
2644 : : ncid = 0
2645 : : ! Create the NetCDF file
2646 : : !ncerr = nf90_create(path=filename,cmode=NF90_CLOBBER,ncid=ncid)
2647 : 4202 : cmode = def_cmode_for_seq_create
2648 : 4202 : ncerr = nf90_create(path=filename, cmode=cmode, ncid=ncid)
2649 [ - + ]: 4202 : NCF_CHECK_MSG(ncerr, sjoin('Error while creating:', filename))
2650 : 4202 : ncerr=nf90_def_dim(ncid,'one',1,one_id)
2651 [ - + ]: 4202 : NCF_CHECK_MSG(ncerr,'nf90_def_dim')
2652 : :
2653 : 4202 : end subroutine create_nc_file
2654 : : !!***
2655 : :
2656 : : !!****f* m_nctk/write_var_netcdf
2657 : : !!
2658 : : !! NAME
2659 : : !! write_var_netcdf
2660 : : !!
2661 : : !! FUNCTION
2662 : : !! Write variable into a netcdf dataset
2663 : : !!
2664 : : !! TODO:
2665 : : !! Remove!
2666 : : !!
2667 : : !! INPUTS
2668 : : !! arr_int
2669 : : !! arr_real
2670 : : !! marr
2671 : : !! narr
2672 : : !! typevar
2673 : : !! varname
2674 : : !!
2675 : : !! OUTPUT
2676 : : !! (only writing)
2677 : : !!
2678 : : !! SOURCE
2679 : :
2680 : 425670 : subroutine write_var_netcdf(arr_int,arr_real,marr,narr,ncid,typevar,varname)
2681 : :
2682 : : !Arguments ------------------------------------
2683 : : !scalars
2684 : : integer,intent(in) :: narr,marr,ncid
2685 : : character(len=*),intent(in) :: varname
2686 : : character(len=3),intent(in) :: typevar
2687 : : !arrays
2688 : : integer,intent(in) :: arr_int(marr)
2689 : : real(dp),intent(in) :: arr_real(marr)
2690 : :
2691 : : !Local variables-------------------------------
2692 : : !scalars
2693 : : integer :: var_id,var_type,vardim_id,ncerr
2694 : : !character(len=500) :: msg
2695 : : ! *************************************************************************
2696 : :
2697 : : !write(std_out,*)"about to write varname: ",trim(varname)
2698 : :
2699 [ + + ]: 425670 : if (ncid>0) then
2700 : : ! ### Put the file in definition mode
2701 : 294582 : ncerr=nf90_redef(ncid)
2702 [ - + ]: 294582 : if (ncerr/=NF90_NOERR.and.ncerr/=NF90_EINDEFINE) then
2703 : 0 : NCF_CHECK_MSG(ncerr,'nf90_redef')
2704 : : end if
2705 : : ! ### Define the dimensions
2706 [ + + ]: 294582 : if (narr==1)then
2707 : 209800 : ncerr=nf90_inq_dimid(ncid,'one',vardim_id)
2708 [ - + ]: 209800 : NCF_CHECK_MSG(ncerr,'nf90_inq_varid')
2709 : : else
2710 : 84782 : ncerr=nf90_def_dim(ncid,trim(varname),narr,vardim_id)
2711 [ - + ]: 84782 : NCF_CHECK_MSG(ncerr,'nf90_def_dim')
2712 : : end if
2713 : : ! ### Define the variables
2714 [ + + ]: 294582 : if (typevar=='INT') then
2715 : 179198 : var_type=NF90_INT
2716 [ + - ]: 115384 : else if (typevar=='DPR') then
2717 : 115384 : var_type=NF90_DOUBLE
2718 : : end if
2719 : 294582 : ncerr=nf90_def_var(ncid, trim(varname), var_type, vardim_id, var_id)
2720 [ - + ]: 294582 : NCF_CHECK_MSG(ncerr,'nf90_def_var')
2721 : : ! ### Put the file in data mode
2722 : 294582 : ncerr=nf90_enddef(ncid)
2723 [ - + ]: 294582 : if (ncerr/=NF90_NOERR.and.ncerr/=NF90_ENOTINDEFINE) then
2724 : 0 : NCF_CHECK_MSG(ncerr,'nf90_enddef')
2725 : : end if
2726 : : ! ### Write variables into the dataset
2727 [ + + ]: 294582 : if (typevar=='INT') then
2728 [ + + ]: 358396 : ncerr=nf90_put_var(ncid,var_id,arr_int,start=(/1/),count=(/narr/))
2729 [ + - ]: 115384 : else if (typevar=='DPR') then
2730 [ + + ]: 230768 : ncerr=nf90_put_var(ncid,var_id,arr_real,start=(/1/),count=(/narr/))
2731 : : end if
2732 [ - + ]: 294582 : NCF_CHECK_MSG(ncerr,'nf90_put_var')
2733 : : end if
2734 : :
2735 : 425670 : end subroutine write_var_netcdf
2736 : : !!***
2737 : :
2738 : : !!****f* ABINIT/write_eig
2739 : : !!
2740 : : !! NAME
2741 : : !! write_eig
2742 : : !!
2743 : : !! FUNCTION
2744 : : !! Write the eigenvalues band by band and k point by k point
2745 : : !! in a NetCDF file format
2746 : : !!
2747 : : !! INPUTS
2748 : : !! filname = Filename of the file where the history will be stored
2749 : : !!
2750 : : !! OUTPUT
2751 : : !! (only writing)
2752 : : !!
2753 : : !! SOURCE
2754 : :
2755 : 2707 : subroutine write_eig(eigen,fermie,filename,kptns,mband,nband,nkpt,nsppol,&
2756 : : & extfpmd_eshift) ! Optional arguments
2757 : :
2758 : : !Arguments ------------------------------------
2759 : : !scalars
2760 : : character(len=fnlen),intent(in) :: filename
2761 : : integer,intent(in) :: nkpt,nsppol,mband
2762 : : real(dp),intent(in) :: fermie
2763 : : real(dp),optional,intent(in) :: extfpmd_eshift
2764 : : !arrays
2765 : : integer,intent(in) :: nband(nkpt*nsppol)
2766 : : real(dp),intent(in) :: eigen(mband*nkpt*nsppol)
2767 : : real(dp),intent(in) :: kptns(3,nkpt)
2768 : :
2769 : : !Local variables-------------------------------
2770 : : !scalars
2771 : : integer :: ncerr,ncid,ii, cmode
2772 : : integer :: xyz_id,nkpt_id,mband_id,nsppol_id
2773 : : integer :: eig_id,fermie_id,kpt_id,nbk_id,nbk
2774 : : integer :: extfpmd_eshift_id
2775 : : integer :: ikpt,isppol,nband_k,band_index
2776 : : real(dp):: convrt
2777 : : !arrays
2778 : : integer :: dimEIG(3),dimKPT(2),dimNBK(2)
2779 : : integer :: count2(2),start2(2)
2780 : : integer :: count3(3),start3(3)
2781 : : integer :: dim0(0)
2782 : 5414 : real(dp):: band(mband)
2783 : : ! *********************************************************************
2784 : :
2785 : 2707 : convrt=1.0_dp
2786 : :
2787 : : !1. Create netCDF file
2788 : : !ncerr = nf90_create(path=trim(filename),cmode=NF90_CLOBBER, ncid=ncid)
2789 : 2707 : cmode = def_cmode_for_seq_create
2790 : 2707 : ncerr = nf90_create(path=trim(filename), cmode=cmode, ncid=ncid)
2791 [ - + ]: 2707 : NCF_CHECK_MSG(ncerr," create netcdf EIG file")
2792 : :
2793 : : !2. Define dimensions
2794 : 2707 : ncerr = nf90_def_dim(ncid,"xyz",3,xyz_id)
2795 [ - + ]: 2707 : NCF_CHECK_MSG(ncerr," define dimension xyz")
2796 : :
2797 : 2707 : ncerr = nf90_def_dim(ncid,"mband",mband,mband_id)
2798 [ - + ]: 2707 : NCF_CHECK_MSG(ncerr," define dimension mband")
2799 : :
2800 : 2707 : ncerr = nf90_def_dim(ncid,"nkpt",nkpt,nkpt_id)
2801 [ - + ]: 2707 : NCF_CHECK_MSG(ncerr," define dimension nkpt")
2802 : :
2803 : 2707 : ncerr = nf90_def_dim(ncid,"nsppol",nsppol,nsppol_id)
2804 [ - + ]: 2707 : NCF_CHECK_MSG(ncerr," define dimension nsppol")
2805 : :
2806 : : !Dimensions for EIGENVALUES
2807 [ + + ]: 10828 : dimEIG = (/ mband_id, nkpt_id, nsppol_id /)
2808 : : !Dimensions for kpoint positions
2809 [ + + ]: 8121 : dimKPT = (/ xyz_id, nkpt_id /)
2810 : : !Dimensions for number kpoints per band and spin
2811 : : !dimNBK = (/ nkpt_id, nsppol_id /)
2812 [ + + ]: 8121 : dimNBK = (/ nkpt_id, nsppol_id /)
2813 : :
2814 : : !3. Define variables
2815 : : call ab_define_var(ncid,dim0,fermie_id,NF90_DOUBLE,&
2816 : 2707 : & "fermie","Chemical potential","Hartree")
2817 : : call ab_define_var(ncid, dimEIG, eig_id, NF90_DOUBLE,&
2818 : : & "Eigenvalues",&
2819 : : & "Values of eigenvalues",&
2820 : 2707 : & "Hartree")
2821 : : call ab_define_var(ncid, dimKPT, kpt_id, NF90_DOUBLE,"Kptns",&
2822 : : & "Positions of K-points in reciprocal space",&
2823 : 2707 : & "Dimensionless")
2824 : : call ab_define_var(ncid, dimNBK, nbk_id, NF90_INT,"NBandK",&
2825 : : & "Number of bands per kpoint and Spin",&
2826 : 2707 : & "Dimensionless")
2827 [ - + ]: 2707 : if(present(extfpmd_eshift)) then
2828 : : call ab_define_var(ncid,dim0,extfpmd_eshift_id,NF90_DOUBLE,&
2829 : 0 : & "extfpmd_eshift","Extended FPMD energy shift","Hartree")
2830 : : end if
2831 : :
2832 : : !4. End define mode
2833 : 2707 : ncerr = nf90_enddef(ncid)
2834 [ - + ]: 2707 : NCF_CHECK_MSG(ncerr," end define mode")
2835 : :
2836 : : !5 Write kpoint positions
2837 [ + + ]: 30793 : do ikpt=1,nkpt
2838 [ + + ]: 84258 : start2 = (/ 1, ikpt /)
2839 : 28086 : count2 = (/ 3, 1 /)
2840 : : ncerr = nf90_put_var(ncid, kpt_id,&
2841 : : & kptns(1:3,ikpt),&
2842 : : & start = start2,&
2843 : 28086 : & count = count2)
2844 [ - + ]: 30793 : NCF_CHECK_MSG(ncerr," write variable kptns")
2845 : : end do
2846 : :
2847 : : !6.1 Write chemical potential
2848 : 2707 : ncerr = nf90_put_var(ncid, fermie_id, fermie)
2849 [ - + ]: 2707 : NCF_CHECK_MSG(ncerr," write variable fermie")
2850 : :
2851 : : !6.2 Write extfpmd shiftfactor
2852 [ - + ]: 2707 : if(present(extfpmd_eshift)) then
2853 : 0 : ncerr = nf90_put_var(ncid, extfpmd_eshift_id, extfpmd_eshift)
2854 [ # # ]: 0 : NCF_CHECK_MSG(ncerr," write variable extfpmd_eshift")
2855 : : end if
2856 : :
2857 : : !6.3 Write eigenvalues
2858 : : band_index=0
2859 [ + + ]: 5679 : do isppol=1,nsppol
2860 [ + + ]: 34814 : do ikpt=1,nkpt
2861 : 29135 : nband_k=nband(ikpt+(isppol-1)*nkpt)
2862 [ + + ]: 116540 : start3 = (/ 1, ikpt, isppol /)
2863 [ + + ]: 116540 : count3 = (/ mband, 1, 1 /)
2864 [ + + ]: 293822 : band(:)=zero
2865 [ + + ]: 293746 : do ii=1,nband_k
2866 : 293746 : band(ii)=eigen(band_index+ii)
2867 : : end do
2868 : : ncerr = nf90_put_var(ncid, eig_id,&
2869 : : & band,&
2870 : : & start = start3,&
2871 : 29135 : & count = count3)
2872 [ - + ]: 29135 : NCF_CHECK_MSG(ncerr," write variable band")
2873 : :
2874 : 32107 : band_index=band_index+nband_k
2875 : : end do
2876 : : end do
2877 : :
2878 : : !6.4 Write Number of bands per kpoint and Spin
2879 : :
2880 [ + + ]: 5679 : do isppol=1,nsppol
2881 [ + + ]: 34814 : do ikpt=1,nkpt
2882 [ + + ]: 87405 : start2 = (/ ikpt, 1 /)
2883 : 29135 : count2 = (/ 1, 1 /)
2884 : 29135 : nbk=nband(ikpt+(isppol-1)*nkpt)
2885 : : ncerr = nf90_put_var(ncid, nbk_id,&
2886 : : & nbk,&
2887 : 29135 : & start = start2)
2888 [ - + ]: 32107 : NCF_CHECK_MSG(ncerr," write variable nband")
2889 : : end do
2890 : : end do
2891 : :
2892 : : !7 Close file
2893 : :
2894 : 2707 : ncerr = nf90_close(ncid)
2895 [ - + ]: 2707 : NCF_CHECK_MSG(ncerr," close netcdf EIG file")
2896 : :
2897 : 2707 : end subroutine write_eig
2898 : : !!***
2899 : :
2900 : 0 : END MODULE m_nctk
2901 : : !!***
|
