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