« back to all changes in this revision
Viewing changes to Src/ncdf/sources/src/netcdf_ncdf.f90
- browse files at revision 1050
- compare with another revision
- download diff
- download tarball
- view history from revision 1050
- Committer: Nick Papior
- Date: 2018-12-06 14:20:30 UTC
- Revision ID: nickpapior@gmail.com-20181206142030-m12ony85o87264aw
Updated fdict and ncdf to latest released versions
Now retrieving dcmplx also works as expected!
Now retrieving dcmplx also works as expected!
- files modified:
- Src/fdict/LICENSE
added
removed
Src/ncdf/sources/src/netcdf_ncdf.f90
90
90
! If define == 1 then it is in data mode (needed for netCDF-3)
91
91
integer :: define
92
92
! The name of the netCDF-file
93
character(len=250) :: name = " "
93
character(len=256) :: name = " "
94
94
! the group of the netCDF-file (i.e. a file within a file)
95
95
character(len=NF90_MAX_NAME) :: grp = " "
96
96
! The communicator describing the parallel activity
121
121
private :: ncdf_def_var_logical
122
122
! Interface for acquiring information about a file...
123
123
interface ncdf_inq
124
module procedure ncdf_inq_ncdf
125
module procedure ncdf_inq_name
124
module procedure ncdf_inq_ncdf
125
module procedure ncdf_inq_name
126
126
end interface ncdf_inq
127
127
private :: ncdf_inq_name
128
128
private :: ncdf_inq_ncdf
129
! Add new data types
130
! We need them to be logical due to the interface of the def_var.
131
! Otherwise they would have the same interface (due to the optional argument var_id)
129
! Add new data types
130
! We need them to be logical due to the interface of the def_var.
131
! Otherwise they would have the same interface (due to the optional argument var_id)
132
132
logical, parameter :: NF90_DOUBLE_COMPLEX = .true. ! for true it is double
133
133
logical, parameter :: NF90_FLOAT_COMPLEX = .false. ! for false it is float
134
134
! This variable is used to enable the NOFILL on certain variables (for the interface to ncdf_def_var)
242
242
module procedure def_fill_i0
243
243
end interface ncdf_def_fill
244
244
contains
245
! Every routine in this module needs NetCDF
246
! So it is sourrounded by this...
245
! Every routine in this module needs NetCDF
246
! So it is sourrounded by this...
247
247
function parallel_(this) result(par)
248
248
type(hNCDF), intent(in) :: this
249
249
logical :: par
292
292
exist = .false.
293
293
if ( present(mode) ) exist = .true.
294
294
if ( present(comm) ) then
295
if ( comm >= 0 ) exist = .true.
295
if ( comm >= 0 ) exist = .true.
296
296
end if
297
297
if ( present(parallel) ) then
298
if ( parallel ) exist = .false.
298
if ( parallel ) exist = .false.
299
299
end if
300
300
if ( .not. exist ) then
301
! Our default is the 64 bit offset files...
302
! The best backwards compatibility format
303
this%mode = IOR(this%mode,NF90_64BIT_OFFSET)
301
! Our default is the 64 bit offset files...
302
! The best backwards compatibility format
303
this%mode = IOR(this%mode,NF90_64BIT_OFFSET)
304
304
end if
305
305
! set the mode
306
306
if ( present(mode) ) then
307
this%mode = mode
307
this%mode = mode
308
308
end if
309
309
! This will create the correct order
310
310
exist = .false.
311
311
if ( present(parallel) ) then
312
if ( parallel ) exist = .true.
312
if ( parallel ) exist = .true.
313
313
end if
314
314
if ( present(comm) ) then
315
if ( comm >= 0 ) exist = .false.
315
if ( comm >= 0 ) exist = .false.
316
316
end if
317
317
if ( exist ) then
318
this%parallel = parallel
319
! The parallel flag is for the sequential parallel access !
320
! This will be reset to a zero mode if a communicator is supplied
321
! In this way we can have "parallel" access for reading purposes...
322
! Check that the mode is not existing in the passed mode
323
this%mode = ior(this%mode, NF90_SHARE)
318
this%parallel = parallel
319
! The parallel flag is for the sequential parallel access !
320
! This will be reset to a zero mode if a communicator is supplied
321
! In this way we can have "parallel" access for reading purposes...
322
! Check that the mode is not existing in the passed mode
323
this%mode = ior(this%mode, NF90_SHARE)
324
324
end if
325
325
if ( present(comm) ) then
326
if ( comm < 0 ) then
327
! If the communicator is negative we
328
! must assume that it is not parallel
329
this%comm = comm
330
end if
326
if ( comm < 0 ) then
327
! If the communicator is negative we
328
! must assume that it is not parallel
329
this%comm = comm
330
end if
331
331
end if
332
332
! Define whether it should not be clobbered
333
333
inquire(file=""//this,exist=exist)
334
334
if ( present(overwrite) ) then
335
if ( exist .and. .not. overwrite ) then
336
this%mode = ior(this%mode, NF90_NOCLOBBER)
337
end if
335
if ( exist .and. .not. overwrite ) then
336
this%mode = ior(this%mode, NF90_NOCLOBBER)
337
end if
338
338
end if
339
339
end subroutine ncdf_init
340
340
subroutine ncdf_create(this,filename,mode,overwrite,parallel,comm, &
341
compress_lvl)
341
compress_lvl)
342
342
type(hNCDF), intent(inout) :: this
343
343
character(len=*), intent(in) :: filename
344
344
integer, optional, intent(in) :: mode
349
349
integer :: file_format
350
350
logical :: exist
351
351
call ncdf_init(this,name=filename, &
352
mode=mode,parallel=parallel,comm=comm, &
353
overwrite=overwrite, &
354
compress_lvl=compress_lvl)
352
mode=mode,parallel=parallel,comm=comm, &
353
overwrite=overwrite, &
354
compress_lvl=compress_lvl)
355
355
! We need to correct the definition for netCDF-3 files
356
356
inquire(file=this%name, exist=exist)
357
357
if ( present(overwrite) ) then
358
if ( overwrite ) then
359
exist = .false.
360
end if
358
if ( overwrite ) then
359
exist = .false.
360
end if
361
361
end if
362
362
if ( iand(NF90_NETCDF4,this%mode) == NF90_NETCDF4 ) then
363
this%define = -1
363
this%define = -1
364
364
end if
365
365
if ( .not. ncdf_participate(this) ) return
366
366
if ( exist ) then
367
call ncdf_die("File: "//this//" already exists! "//&
368
"Please delete the file (or request overwriting).")
367
call ncdf_die("File: "//this//" already exists! "//&
368
"Please delete the file (or request overwriting).")
369
369
end if
370
370
if ( this%parallel .and. this%comm >= 0 ) then
371
call ncdf_err(-100,"Not compiled with communicater parallel")
371
call ncdf_err(-100,"Not compiled with communicater parallel")
372
372
else if ( this%parallel ) then
373
call ncdf_err(nf90_create(filename, this%mode , this%f_id), &
374
"Creating file: "//this//" in parallel")
373
call ncdf_err(nf90_create(filename, this%mode , this%f_id), &
374
"Creating file: "//this//" in parallel")
375
375
else
376
call ncdf_err(nf90_create(filename, this%mode , this%f_id), &
377
"Creating file: "//this)
376
call ncdf_err(nf90_create(filename, this%mode , this%f_id), &
377
"Creating file: "//this)
378
378
end if
379
379
! We could check for mode == NF90_SHARE in case of parallel...
380
380
! However, it does not make sense as the other is still correct, just slow
392
392
logical :: exist
393
393
! Save the general information which should be accesible to all processors
394
394
call ncdf_init(this,name=filename,mode=mode, &
395
parallel=parallel,comm=comm, &
396
compress_lvl=compress_lvl)
395
parallel=parallel,comm=comm, &
396
compress_lvl=compress_lvl)
397
397
! When we open a file, it will always be in data mode...
398
398
if ( iand(NF90_NETCDF4,this%mode) == NF90_NETCDF4 ) then
399
this%define = -1
399
this%define = -1
400
400
else
401
this%define = 1
401
this%define = 1
402
402
end if
403
403
if ( .not. ncdf_participate(this) ) return
404
404
inquire(file=filename, exist=exist)
405
405
if ( .not. exist ) then
406
call ncdf_die("File: "//trim(filename)//" does not exist! "//&
407
"Please check your inqueries.")
406
call ncdf_die("File: "//trim(filename)//" does not exist! "//&
407
"Please check your inqueries.")
408
408
end if
409
409
! If we have not added a mode it must be for non-writing purposes
410
410
if ( .not. present(mode) ) then
411
this%mode = IOR(this%mode,NF90_NOWRITE)
411
this%mode = IOR(this%mode,NF90_NOWRITE)
412
412
end if
413
413
if ( this%parallel .and. this%comm >= 0 ) then
414
call ncdf_err(-100,"Code not compiled with NCDF_PARALLEL")
414
call ncdf_err(-100,"Code not compiled with NCDF_PARALLEL")
415
415
else if ( this%parallel ) then
416
call ncdf_err(nf90_open(filename, this%mode , this%f_id), &
417
"Opening file: "//this//" in parallel")
416
call ncdf_err(nf90_open(filename, this%mode , this%f_id), &
417
"Opening file: "//this//" in parallel")
418
418
else
419
call ncdf_err(nf90_open(filename, this%mode , this%f_id), &
420
"Opening file: "//this)
419
call ncdf_err(nf90_open(filename, this%mode , this%f_id), &
420
"Opening file: "//this)
421
421
end if
422
422
! Copy so that we can create inquiry
423
423
this%id = this%f_id
424
424
if ( present(group) ) then
425
this%grp = '/'//trim(group)
426
call ncdf_err(nf90_inq_grp_full_ncid(this%f_id, trim(this%grp), this%id))
425
this%grp = '/'//trim(group)
426
call ncdf_err(nf90_inq_grp_full_ncid(this%f_id, trim(this%grp), this%id))
427
427
end if
428
428
end subroutine ncdf_open
429
429
! A specific routine for generating a NetCDF file
439
439
type(var) :: v
440
440
character(len=DICT_KEY_LENGTH) :: key
441
441
character(len=NF90_MAX_NAME) :: name, char
442
character(len=50), allocatable :: dims(:)
442
character(len=64), allocatable :: dims(:)
443
443
integer, pointer :: chunks(:) => null()
444
444
integer :: d_n, type, i, n_d, j
445
445
! Type declarations
449
449
! Create all dimensions
450
450
d = .first. dic
451
451
do while ( .not. (.empty. d) )
452
key = .key. d
453
if ( key(1:3) == 'DIM' ) then
454
key = key(4:)
455
! We have a dimension
456
! { DIMname : <size> }
457
! 1. Get value
458
call associate(v,d)
459
! 2. Assign value
460
call assign(d_n,v)
461
call ncdf_def_dim(this,key,d_n)
462
! 3. just nullify the variable, let the user delete
463
! the dictionary, we cannot know whether the
464
! variable is a pointer.
465
call nullify(v)
466
end if
467
d = .next. d
452
key = .key. d
453
if ( key(1:3) == 'DIM' ) then
454
key = key(4:)
455
! We have a dimension
456
! { DIMname : <size> }
457
! 1. Get value
458
call associate(v,d)
459
! 2. Assign value
460
call assign(d_n,v)
461
call ncdf_def_dim(this,key,d_n)
462
! 3. just nullify the variable, let the user delete
463
! the dictionary, we cannot know whether the
464
! variable is a pointer.
465
call nullify(v)
466
end if
467
d = .next. d
468
468
end do
469
469
! Create all variables
470
470
d = .first. dic
471
471
do while ( .not. (.empty. d) )
472
key = .key. d
473
if ( key(1:3) == 'VAR' ) then
474
name = key(4:)
475
!print *,'Creating variable: ',trim(key)
476
! We have a variable
477
! { VARname : <dict> } dict ->
478
! {
479
! dims : '1st,2nd,3rd', ! Comma-seperated list
480
! type : NF90_INT|NF90_FLOAT|..., ! Integer, or logical for complex
481
! atts : <dict>, ! Dictionary of attributes.
482
! chunks : <array of int>, ! For specifying chunk-sizes
483
! }
484
call associate(d_var,d)
485
!call print(d_var)
486
! We have the dictionary of the variable
487
! 0. in case 'name' exists, it must be the name
488
if ( 'name'.in.d_var ) then
489
call associate(v,d_var,'name')
490
if ( which(v) /= 'a1' ) then
491
call ncdf_err(-200, &
492
'Name of variable is not a character variable.')
493
end if
494
name = ' '
495
call assign(name,v)
496
end if
497
! 1. Get the dimensions
498
if ( 'dims'.nin. d_var ) then
499
call ncdf_err(-200, &
500
'Unable to retrieve the dimension &
501
&key from a variable dictionary. A variable &
502
&MUST be defined with a comma separated dimension.')
503
end if
504
!print *,'Retrieve dims (1): ',trim(key)
505
call associate(v,d_var,'dims')
506
! The dimensions has to be given in a comma separated list
472
key = .key. d
473
if ( key(1:3) == 'VAR' ) then
474
name = key(4:)
475
!print *,'Creating variable: ',trim(key)
476
! We have a variable
477
! { VARname : <dict> } dict ->
478
! {
479
! dims : '1st,2nd,3rd', ! Comma-seperated list
480
! type : NF90_INT|NF90_FLOAT|..., ! Integer, or logical for complex
481
! atts : <dict>, ! Dictionary of attributes.
482
! chunks : <array of int>, ! For specifying chunk-sizes
483
! }
484
call associate(d_var,d)
485
!call print(d_var)
486
! We have the dictionary of the variable
487
! 0. in case 'name' exists, it must be the name
488
if ( 'name'.in.d_var ) then
489
call associate(v,d_var,'name')
507
490
if ( which(v) /= 'a1' ) then
508
call ncdf_err(-200, &
509
'Dimension variable is not a character variable.')
510
end if
511
! Ensure we have a completely empty character.
512
!print *,'Retrieve dims (2): ',trim(key)
513
key = ' '
514
call assign(key,v)
515
! Count number of dimensions
516
n_d = 1
517
do i = 1 , len_trim(key)
518
if ( key(i:i) == ',' ) then
519
n_d = n_d + 1
520
end if
521
end do
522
allocate(dims(n_d))
523
! Copy over the dimensions
524
j = 1
525
n_d = 1
526
do i = 2 , len_trim(key)
527
if ( key(i:i) == ',' ) then
528
dims(n_d) = ' '
529
dims(n_d) = trim(adjustl(key(j:i-1)))
530
n_d = n_d + 1
531
j = i + 1
532
end if
533
end do
534
! Grab the last dimension
535
dims(n_d) = trim(adjustl(key(j:)))
536
! Figure out the type
537
if ( 'type' .nin. d_var ) then
538
call ncdf_err(-200, &
539
'Unable to retrieve the type &
540
&key from a variable dictionary. A variable &
541
&MUST have a clear type.')
542
end if
543
!print *,'Retrieve type: ',trim(key)
544
call associate(v,d_var,'type')
545
char = which(v)
546
if ( trim(char) /= 'b0' .and. &
547
trim(char) /= 'i0' ) then
548
call ncdf_err(-200, &
549
'Type of variable is not defined with a &
550
&proper variable designator.')
551
end if
552
if ( trim(char) == 'i0' ) then
553
call assign(itype,v)
554
else
555
call assign(ltype,v)
556
end if
557
! Check if there are any attributes in the dictionary
558
if ( 'atts' .in. d_var ) then
559
call associate(atts,d_var,'atts')
560
end if
561
! We have now gathered all information.
562
! Lets create that variable, alrighty! :)
563
if ( trim(char) == 'i0' ) then
564
call ncdf_def_var(this,name,itype, &
565
dims=dims,atts=atts)
566
else
567
call ncdf_def_var(this,name,ltype, &
568
dims=dims,atts=atts)
569
end if
570
deallocate(dims)
571
call nullify(atts)
572
call nullify(v)
573
call nullify(d_var)
574
else if ( key(1:5) == 'GROUP' ) then
575
name = key(6:) ! default name
576
if ( 'name' .in. d_var ) then
577
call associate(v,d_var,'name')
578
name = ' '
579
call assign(name,v)
580
end if
581
call ncdf_def_grp(this,name,grp)
582
call associate(d_var,d)
583
call ncdf_crt(grp,d_var)
584
call nullify(d_var)
585
end if
586
d = .next. d
491
call ncdf_err(-200, &
492
'Name of variable is not a character variable.')
493
end if
494
name = ' '
495
call assign(name,v)
496
end if
497
! 1. Get the dimensions
498
if ( 'dims'.nin. d_var ) then
499
call ncdf_err(-200, &
500
'Unable to retrieve the dimension &
501
&key from a variable dictionary. A variable &
502
&MUST be defined with a comma separated dimension.')
503
end if
504
!print *,'Retrieve dims (1): ',trim(key)
505
call associate(v,d_var,'dims')
506
! The dimensions has to be given in a comma separated list
507
if ( which(v) /= 'a1' ) then
508
call ncdf_err(-200, &
509
'Dimension variable is not a character variable.')
510
end if
511
! Ensure we have a completely empty character.
512
!print *,'Retrieve dims (2): ',trim(key)
513
key = ' '
514
call assign(key,v)
515
! Count number of dimensions
516
n_d = 1
517
do i = 1 , len_trim(key)
518
if ( key(i:i) == ',' ) then
519
n_d = n_d + 1
520
end if
521
end do
522
allocate(dims(n_d))
523
! Copy over the dimensions
524
j = 1
525
n_d = 1
526
do i = 2 , len_trim(key)
527
if ( key(i:i) == ',' ) then
528
dims(n_d) = ' '
529
dims(n_d) = trim(adjustl(key(j:i-1)))
530
n_d = n_d + 1
531
j = i + 1
532
end if
533
end do
534
! Grab the last dimension
535
dims(n_d) = trim(adjustl(key(j:)))
536
! Figure out the type
537
if ( 'type' .nin. d_var ) then
538
call ncdf_err(-200, &
539
'Unable to retrieve the type &
540
&key from a variable dictionary. A variable &
541
&MUST have a clear type.')
542
end if
543
!print *,'Retrieve type: ',trim(key)
544
call associate(v,d_var,'type')
545
char = which(v)
546
if ( trim(char) /= 'b0' .and. &
547
trim(char) /= 'i0' ) then
548
call ncdf_err(-200, &
549
'Type of variable is not defined with a &
550
&proper variable designator.')
551
end if
552
if ( trim(char) == 'i0' ) then
553
call assign(itype,v)
554
else
555
call assign(ltype,v)
556
end if
557
! Check if there are any attributes in the dictionary
558
if ( 'atts' .in. d_var ) then
559
call associate(atts,d_var,'atts')
560
end if
561
! We have now gathered all information.
562
! Lets create that variable, alrighty! :)
563
if ( trim(char) == 'i0' ) then
564
call ncdf_def_var(this,name,itype, &
565
dims=dims,atts=atts)
566
else
567
call ncdf_def_var(this,name,ltype, &
568
dims=dims,atts=atts)
569
end if
570
deallocate(dims)
571
call nullify(atts)
572
call nullify(v)
573
call nullify(d_var)
574
else if ( key(1:5) == 'GROUP' ) then
575
name = key(6:) ! default name
576
if ( 'name' .in. d_var ) then
577
call associate(v,d_var,'name')
578
name = ' '
579
call assign(name,v)
580
end if
581
call ncdf_def_grp(this,name,grp)
582
call associate(d_var,d)
583
call ncdf_crt(grp,d_var)
584
call nullify(d_var)
585
end if
586
d = .next. d
587
587
end do
588
588
end subroutine ncdf_crt
589
589
! Handy routine for completely deleting a
597
597
! Delete all entries
598
598
ld = .first. dic
599
599
do while ( .not. (.empty.ld) )
600
key = .key. ld
601
if ( key(1:3) == 'VAR' ) then
602
call associate(v_dic,ld)
603
if ( 'atts'.in.v_dic ) then
604
call associate(att_dic,v_dic)
605
call delete(att_dic)
606
end if
607
call delete(v_dic)
608
else if ( key(1:5) == 'GROUP' ) then
609
call associate(v_dic,ld)
610
ld = .next. ld
611
call ncdf_crt_delete(v_dic)
612
cycle
613
end if
614
ld = .next. ld
600
key = .key. ld
601
if ( key(1:3) == 'VAR' ) then
602
call associate(v_dic,ld)
603
if ( 'atts'.in.v_dic ) then
604
call associate(att_dic,v_dic)
605
call delete(att_dic)
606
end if
607
call delete(v_dic)
608
else if ( key(1:5) == 'GROUP' ) then
609
call associate(v_dic,ld)
610
ld = .next. ld
611
call ncdf_crt_delete(v_dic)
612
cycle
613
end if
614
ld = .next. ld
615
615
end do
616
616
call delete(dic)
617
617
end subroutine ncdf_crt_delete
629
629
call h_reset(this)
630
630
end subroutine ncdf_close
631
631
subroutine ncdf_inq_ncdf(this,dims,vars,atts,format,grps,exist, &
632
dict_dim, dict_att)
632
dict_dim, dict_att)
633
633
use dictionary
634
634
type(hNCDF), intent(inout) :: this
635
635
integer, optional, intent(out) :: dims, vars, atts, format, grps
642
642
if ( .not. ncdf_participate(this) ) return
643
643
! A file-check has been requested...
644
644
if ( present(exist) ) then
645
inquire(file=this%name,exist=exist)
646
! if it does not exist we simply return
647
! this ensures that the user can request all the information
648
! at once
649
if ( .not. exist ) then
650
return
651
end if
645
inquire(file=this%name,exist=exist)
646
! if it does not exist we simply return
647
! this ensures that the user can request all the information
648
! at once
649
if ( .not. exist ) then
650
return
651
end if
652
652
end if
653
653
call ncdf_err(nf90_inquire(this%id,ldims,lvars,latts,formatNum=lformat), &
654
"Inquiring file information "//this)
654
"Inquiring file information "//this)
655
655
! Copy over requested information...
656
656
if ( present(dims) ) dims = ldims
657
657
if ( present(vars) ) vars = lvars
658
658
if ( present(atts) ) atts = latts
659
659
if ( present(format) ) format = lformat
660
660
if ( present(dict_dim) ) then
661
call delete(dict_dim)
662
do i = 1 , ldims
663
call ncdf_err(nf90_inquire_dimension(this%id,i,name=key))
664
call ncdf_inq_dim(this,key,len=val)
665
dict_dim = dict_dim // (trim(key).kv.val)
666
end do
661
call delete(dict_dim)
662
do i = 1 , ldims
663
call ncdf_err(nf90_inquire_dimension(this%id,i,name=key))
664
call ncdf_inq_dim(this,key,len=val)
665
dict_dim = dict_dim // (trim(key).kv.val)
666
end do
667
667
end if
668
668
if ( present(dict_att) ) then
669
call delete(dict_att)
670
call get_atts_id(this,NF90_GLOBAL,dict_att)
669
call delete(dict_att)
670
call get_atts_id(this,NF90_GLOBAL,dict_att)
671
671
end if
672
672
if ( present(grps) ) then
673
if ( IAND(this%mode,NF90_NETCDF4) == NF90_NETCDF4 ) then
674
allocate(grp_id(50))
673
if ( IAND(this%mode,NF90_NETCDF4) == NF90_NETCDF4 ) then
674
allocate(grp_id(50))
675
call ncdf_err(nf90_inq_grps(this%id,grps,grp_id), &
676
"Inquiring file information "//this)
677
if ( grps > size(grp_id) ) then
678
deallocate(grp_id)
679
allocate(grp_id(grps))
675
680
call ncdf_err(nf90_inq_grps(this%id,grps,grp_id), &
676
"Inquiring file information "//this)
677
if ( grps > size(grp_id) ) then
678
deallocate(grp_id)
679
allocate(grp_id(grps))
680
call ncdf_err(nf90_inq_grps(this%id,grps,grp_id), &
681
"Inquiring file information "//this)
682
deallocate(grp_id)
683
end if
684
else
685
grps = -1
686
end if
681
"Inquiring file information "//this)
682
deallocate(grp_id)
683
end if
684
else
685
grps = -1
686
end if
687
687
end if
688
688
end subroutine ncdf_inq_ncdf
689
689
subroutine ncdf_inq_name(name,dims,vars,atts,format,grps,exist, &
690
dict_dim, dict_att)
690
dict_dim, dict_att)
691
691
use dictionary
692
692
character(len=*), intent(in) :: name
693
693
integer, optional, intent(out) :: dims, vars, atts, format, grps
697
697
type(hNCDF) :: this
698
698
! A file-check has been requested...
699
699
if ( present(exist) ) then
700
inquire(file=name,exist=exist)
701
if ( .not. exist ) then
702
return
703
end if
700
inquire(file=name,exist=exist)
701
if ( .not. exist ) then
702
return
703
end if
704
704
end if
705
705
! Open the file...
706
706
call ncdf_open(this,name,parallel=.false.)
707
707
! Do the inquiry...
708
708
call ncdf_inq_ncdf(this,dims=dims,vars=vars,atts=atts,grps=grps,&
709
format=format,dict_dim=dict_dim,dict_att=dict_att)
709
format=format,dict_dim=dict_dim,dict_att=dict_att)
710
710
! Close the file
711
711
call ncdf_close(this)
712
712
end subroutine ncdf_inq_name
713
713
subroutine ncdf_inq_grp(this,group,exist,dims,vars,atts,format,grps, &
714
dict_dim, dict_att)
714
dict_dim, dict_att)
715
715
use dictionary
716
716
type(hNCDF), intent(inout) :: this
717
717
character(len=*), intent(in) :: group
725
725
type(hNCDF) :: grp
726
726
if ( .not. ncdf_participate(this) ) return
727
727
if ( present(exist) ) then
728
i = nf90_inq_grp_ncid(this%id,group,val)
729
if ( i == NF90_NOERR ) then
730
exist = .true.
731
else if ( i == NF90_ENOGRP ) then
732
exist = .false.
733
else
734
call ncdf_err(i, &
735
'Inquiring group information'//this)
736
end if
737
if ( exist ) then
738
! We can fetch the other information
739
call ncdf_open_grp(this,group,grp)
740
call ncdf_inq(grp,dims=dims,vars=vars,atts=atts,format=format, &
741
grps=grps,dict_dim=dict_dim,dict_att=dict_att)
742
end if
743
return
728
i = nf90_inq_grp_ncid(this%id,group,val)
729
if ( i == NF90_NOERR ) then
730
exist = .true.
731
else if ( i == NF90_ENOGRP ) then
732
exist = .false.
733
else
734
call ncdf_err(i, &
735
'Inquiring group information'//this)
736
end if
737
if ( exist ) then
738
! We can fetch the other information
739
call ncdf_open_grp(this,group,grp)
740
call ncdf_inq(grp,dims=dims,vars=vars,atts=atts,format=format, &
741
grps=grps,dict_dim=dict_dim,dict_att=dict_att)
742
end if
743
return
744
744
end if
745
745
call ncdf_open_grp(this,group,grp)
746
746
call ncdf_inq(grp,dims=dims,vars=vars,atts=atts,format=format, &
747
grps=grps,dict_dim=dict_dim,dict_att=dict_att)
747
grps=grps,dict_dim=dict_dim,dict_att=dict_att)
748
748
end subroutine ncdf_inq_grp
749
749
! Routine to assert that a NetCDF file has
750
750
! certain dimensions, attributes, and variables.
756
756
! The latter only checks if they exist in the
757
757
! file.
758
758
subroutine ncdf_assert(this,assert,dims,vars, &
759
has_dims,has_vars,s_EPS,d_EPS)
759
has_dims,has_vars,s_EPS,d_EPS)
760
760
use variable
761
761
use dictionary
762
762
type(hNCDF), intent(inout) :: this
770
770
! It just needs to be done...
771
771
! We can currently only check integers :(
772
772
character(len=DICT_KEY_LENGTH) :: key
773
character(len=2) :: t
773
character(len=VAR_TYPE_LENGTH) :: t
774
774
type(dict) :: dic ! local loop dictionary...
775
775
type(var) :: ivar
776
776
logical :: success
787
787
assert = .true.
788
788
if ( .not. ncdf_participate(this) ) return
789
789
if ( present(dims) ) then
790
! We check the dimensions of the file
791
dic = .first. dims
792
do while ( .not. (.empty. dic) )
793
key = .key. dic
794
! Check that the dimension exists
795
call ncdf_inq_dim(this,key,exist=assert)
796
if ( .not. assert ) exit
797
! Get the value in the dictionary
798
ivar = .valp. dic
790
! We check the dimensions of the file
791
dic = .first. dims
792
do while ( .not. (.empty. dic) )
793
key = .key. dic
794
! Check that the dimension exists
795
call ncdf_inq_dim(this,key,exist=assert)
796
if ( .not. assert ) exit
797
! Get the value in the dictionary
798
ivar = .valp. dic
799
call assign(i0,ivar,success=success)
800
if ( .not. success ) then
801
! Error in type of dictionary...
802
call ncdf_err(-100, &
803
'Request of dimension in ncdf_assert &
804
&went wrong, the dimension is not an integer.')
805
end if
806
call nullify(ivar)
807
! Now find the dimension size
808
call ncdf_inq_dim(this,key,len=i)
809
! Now we can actually check it...
810
assert = ( i == i0 )
811
if ( .not. assert ) exit
812
dic = .next. dic
813
end do
814
! Clean up... (the variable allocates the "enc")
815
call nullify(ivar)
816
if ( .not. assert ) return
817
end if
818
if ( present(vars) ) then
819
! We retrieve the epsilon for check
820
ls_EPS = 1.e-6_sp
821
if ( present(s_EPS) ) ls_EPS = s_EPS
822
ld_EPS = 1.e-6_dp
823
if ( present(d_EPS) ) ld_EPS = d_EPS
824
! We check the dimensions of the file
825
dic = .first. vars
826
do while ( .not. (.empty. dic) )
827
key = .key. dic
828
! Check that the variable exists
829
call ncdf_inq_var(this,key,exist=assert)
830
if ( .not. assert ) exit
831
! Get the value in the dictionary
832
ivar = .valp. dic
833
t = which(ivar)
834
select case ( t )
835
case ( 'i0' )
799
836
call assign(i0,ivar,success=success)
800
if ( .not. success ) then
801
! Error in type of dictionary...
802
call ncdf_err(-100, &
803
'Request of dimension in ncdf_assert &
804
&went wrong, the dimension is not an integer.')
805
end if
806
call nullify(ivar)
807
! Now find the dimension size
808
call ncdf_inq_dim(this,key,len=i)
809
! Now we can actually check it...
837
case ( 'i1' )
838
call associate(i1,ivar,success=success)
839
case ( 'i2' )
840
call associate(i2,ivar,success=success)
841
case ( 's1' )
842
call associate(s1,ivar,success=success)
843
case ( 's2' )
844
call associate(s2,ivar,success=success)
845
case ( 'd1' )
846
call associate(d1,ivar,success=success)
847
case ( 'd2' )
848
call associate(d2,ivar,success=success)
849
case default
850
success = .false.
851
end select
852
if ( .not. success ) then
853
! Error in type of dictionary...
854
call ncdf_err(-100, &
855
'Request of variable in input vars in ncdf_assert &
856
&went wrong, the variable is not [i0,i1,i2,s1,s2,d1,d2].')
857
end if
858
! Do not deallocate the dictionary stuff
859
call nullify(ivar)
860
! Now grab the first elements of the variable
861
! First we need to allocate the read in data
862
! array
863
select case ( t )
864
case ( 'i0' )
865
call ncdf_get_var(this,key,i)
810
866
assert = ( i == i0 )
811
if ( .not. assert ) exit
812
dic = .next. dic
813
end do
814
! Clean up... (the variable allocates the "enc")
815
call nullify(ivar)
816
if ( .not. assert ) return
817
end if
818
if ( present(vars) ) then
819
! We retrieve the epsilon for check
820
ls_EPS = 1.e-6_sp
821
if ( present(s_EPS) ) ls_EPS = s_EPS
822
ld_EPS = 1.e-6_dp
823
if ( present(d_EPS) ) ld_EPS = d_EPS
824
! We check the dimensions of the file
825
dic = .first. vars
826
do while ( .not. (.empty. dic) )
827
key = .key. dic
828
! Check that the variable exists
829
call ncdf_inq_var(this,key,exist=assert)
830
if ( .not. assert ) exit
831
! Get the value in the dictionary
832
ivar = .valp. dic
833
t = which(ivar)
834
select case ( t )
835
case ( 'i0' )
836
call assign(i0,ivar,success=success)
837
case ( 'i1' )
838
call associate(i1,ivar,success=success)
839
case ( 'i2' )
840
call associate(i2,ivar,success=success)
841
case ( 's1' )
842
call associate(s1,ivar,success=success)
843
case ( 's2' )
844
call associate(s2,ivar,success=success)
845
case ( 'd1' )
846
call associate(d1,ivar,success=success)
847
case ( 'd2' )
848
call associate(d2,ivar,success=success)
849
case default
850
success = .false.
851
end select
852
if ( .not. success ) then
853
! Error in type of dictionary...
854
call ncdf_err(-100, &
855
'Request of variable in input vars in ncdf_assert &
856
&went wrong, the variable is not [i0,i1,i2,s1,s2,d1,d2].')
857
end if
858
! Do not deallocate the dictionary stuff
859
call nullify(ivar)
860
! Now grab the first elements of the variable
861
! First we need to allocate the read in data
862
! array
863
select case ( t )
864
case ( 'i0' )
865
call ncdf_get_var(this,key,i)
866
assert = ( i == i0 )
867
case ( 'i1' )
868
allocate(i1a(size(i1)))
869
call ncdf_get_var(this,key,i1a)
870
assert = all( i1 == i1a )
871
deallocate(i1a)
872
case ( 'i2' )
873
allocate(i2a(size(i2,dim=1),size(i2,dim=2)))
874
call ncdf_get_var(this,key,i2a)
875
assert = all( i2 == i2a )
876
deallocate(i2a)
877
case ( 's1' )
878
allocate(s1a(size(s1)))
879
call ncdf_get_var(this,key,s1a)
880
assert = all( abs(s1 - s1a) <= ls_EPS )
881
deallocate(s1a)
882
case ( 's2' )
883
allocate(s2a(size(s2,dim=1),size(s2,dim=2)))
884
call ncdf_get_var(this,key,s2a)
885
assert = all( abs(s2 - s2a) <= ls_EPS )
886
deallocate(s2a)
887
case ( 'd1' )
888
allocate(d1a(size(d1)))
889
call ncdf_get_var(this,key,d1a)
890
assert = all( abs(d1 - d1a) <= ld_EPS )
891
deallocate(d1a)
892
case ( 'd2' )
893
allocate(d2a(size(d2,dim=1),size(d2,dim=2)))
894
call ncdf_get_var(this,key,d2a)
895
assert = all( abs(d2 - d2a) <= ld_EPS )
896
deallocate(d2a)
897
end select
898
! no success...
899
if ( .not. assert ) exit
900
dic = .next. dic
901
end do
902
! Clean up...
903
call nullify(ivar)
904
if ( .not. assert ) return
867
case ( 'i1' )
868
allocate(i1a(size(i1)))
869
call ncdf_get_var(this,key,i1a)
870
assert = all( i1 == i1a )
871
deallocate(i1a)
872
case ( 'i2' )
873
allocate(i2a(size(i2,dim=1),size(i2,dim=2)))
874
call ncdf_get_var(this,key,i2a)
875
assert = all( i2 == i2a )
876
deallocate(i2a)
877
case ( 's1' )
878
allocate(s1a(size(s1)))
879
call ncdf_get_var(this,key,s1a)
880
assert = all( abs(s1 - s1a) <= ls_EPS )
881
deallocate(s1a)
882
case ( 's2' )
883
allocate(s2a(size(s2,dim=1),size(s2,dim=2)))
884
call ncdf_get_var(this,key,s2a)
885
assert = all( abs(s2 - s2a) <= ls_EPS )
886
deallocate(s2a)
887
case ( 'd1' )
888
allocate(d1a(size(d1)))
889
call ncdf_get_var(this,key,d1a)
890
assert = all( abs(d1 - d1a) <= ld_EPS )
891
deallocate(d1a)
892
case ( 'd2' )
893
allocate(d2a(size(d2,dim=1),size(d2,dim=2)))
894
call ncdf_get_var(this,key,d2a)
895
assert = all( abs(d2 - d2a) <= ld_EPS )
896
deallocate(d2a)
897
end select
898
! no success...
899
if ( .not. assert ) exit
900
dic = .next. dic
901
end do
902
! Clean up...
903
call nullify(ivar)
904
if ( .not. assert ) return
905
905
end if
906
906
if ( present(has_dims) ) then
907
! We check the dimensions of the file
908
dic = .first. has_dims
909
do while ( .not. (.empty. dic) )
910
key = .key. dic
911
call ncdf_inq_dim(this,key,exist=assert)
912
if ( .not. assert ) return
913
dic = .next. dic
914
end do
907
! We check the dimensions of the file
908
dic = .first. has_dims
909
do while ( .not. (.empty. dic) )
910
key = .key. dic
911
call ncdf_inq_dim(this,key,exist=assert)
912
if ( .not. assert ) return
913
dic = .next. dic
914
end do
915
915
end if
916
916
if ( present(has_vars) ) then
917
dic = .first. has_vars
918
do while ( .not. (.empty. dic) )
919
key = .key. dic
920
call ncdf_inq_var(this,key,exist=assert)
921
if ( .not. assert ) return
922
dic = .next. dic
923
end do
917
dic = .first. has_vars
918
do while ( .not. (.empty. dic) )
919
key = .key. dic
920
call ncdf_inq_var(this,key,exist=assert)
921
if ( .not. assert ) return
922
dic = .next. dic
923
end do
924
924
end if
925
925
end subroutine ncdf_assert
926
! Simplify the addition of any dimension
926
! Simplify the addition of any dimension
927
927
subroutine ncdf_def_dim(this,name,size)
928
928
type(hNCDF), intent(inout) :: this
929
929
character(len=*), intent(in) :: name
934
934
! in case of netCDF-3 this will not change anything
935
935
call ncdf_redef(this)
936
936
call ncdf_err(nf90_def_dim(this%id, name, size, id),&
937
"Defining dimension: "//trim(name)//" in file: "//this)
937
"Defining dimension: "//trim(name)//" in file: "//this)
938
938
end subroutine ncdf_def_dim
939
! Simplify the renaming of any dimension
939
! Simplify the renaming of any dimension
940
940
subroutine ncdf_rename_var(this,old_name,new_name)
941
941
type(hNCDF), intent(inout) :: this
942
942
character(len=*), intent(in) :: old_name, new_name
945
945
call ncdf_redef(this)
946
946
call ncdf_inq_var(this,old_name,id=id)
947
947
call ncdf_err(nf90_rename_var(this%id, id, new_name),&
948
"Renaming variable: "//trim(old_name)//" to "//&
949
trim(new_name)//" in file: "//this)
948
"Renaming variable: "//trim(old_name)//" to "//&
949
trim(new_name)//" in file: "//this)
950
950
end subroutine ncdf_rename_var
951
! Simplify the renaming of any dimension
951
! Simplify the renaming of any dimension
952
952
subroutine ncdf_rename_dim(this,old_name,new_name)
953
953
type(hNCDF), intent(inout) :: this
954
954
character(len=*), intent(in) :: old_name, new_name
957
957
call ncdf_redef(this)
958
958
call ncdf_inq_dim(this,old_name,id=id)
959
959
call ncdf_err(nf90_rename_dim(this%id, id, new_name),&
960
"Renaming dimension: "//trim(old_name)//" to "//&
961
trim(new_name)//" in file: "//this)
960
"Renaming dimension: "//trim(old_name)//" to "//&
961
trim(new_name)//" in file: "//this)
962
962
end subroutine ncdf_rename_dim
963
963
subroutine ncdf_rename_att(this,var,old_name,new_name)
964
964
type(hNCDF), intent(inout) :: this
968
968
call ncdf_redef(this)
969
969
call ncdf_inq_var(this,var,id=id)
970
970
call ncdf_err(nf90_rename_att(this%id, id, old_name, new_name),&
971
"Renaming variable ("//trim(var)//") attribute: "//trim(old_name)&
972
//" to "//trim(new_name)//" in file: "//this)
971
"Renaming variable ("//trim(var)//") attribute: "//trim(old_name)&
972
//" to "//trim(new_name)//" in file: "//this)
973
973
end subroutine ncdf_rename_att
974
974
subroutine ncdf_rename_gatt(this,old_name,new_name)
975
975
type(hNCDF), intent(inout) :: this
977
977
if ( .not. ncdf_participate(this) ) return
978
978
call ncdf_redef(this)
979
979
call ncdf_err(nf90_rename_att(this%id, NF90_GLOBAL, old_name, new_name),&
980
"Renaming global attribute: "//trim(old_name)&
981
//" to "//trim(new_name)//" in file: "//this)
980
"Renaming global attribute: "//trim(old_name)&
981
//" to "//trim(new_name)//" in file: "//this)
982
982
end subroutine ncdf_rename_gatt
983
! Simplify the addition of a variable...
984
! This routine *MUST* be called after ncdf_participate
985
! (however, as it is a local routine the burden is ours, not the programmers)
983
! Simplify the addition of a variable...
984
! This routine *MUST* be called after ncdf_participate
985
! (however, as it is a local routine the burden is ours, not the programmers)
986
986
subroutine ncdf_def_var_generic(this,name,type,dims,id,atts, &
987
compress_lvl,shuffle, access, chunks)
987
compress_lvl,shuffle, access, chunks)
988
988
use variable
989
989
use dictionary
990
990
type(hNCDF), intent(inout) :: this
999
999
integer :: iret, i, ldims(size(dims))
1000
1000
call ncdf_redef(this)
1001
1001
do i = 1 , size(dims)
1002
call ncdf_inq_dim(this,trim(dims(i)),id=ldims(i))
1002
call ncdf_inq_dim(this,trim(dims(i)),id=ldims(i))
1003
1003
end do
1004
! Determine whether we have NetCDF 4 enabled, in that case do compression if asked for
1004
! Determine whether we have NetCDF 4 enabled, in that case do compression if asked for
1005
1005
! In case of NetCDF 3
1006
1006
iret = nf90_def_var(this%id, name, type, ldims, id)
1007
1007
call ncdf_err(iret,"Defining variable: "//trim(name)//" in file: "//this)
1008
1008
if ( present(atts) ) then
1009
call put_atts_id(this,id,atts)
1009
call put_atts_id(this,id,atts)
1010
1010
end if
1011
1011
if ( present(access) ) then
1012
call ncdf_par_access(this,name=name,access=access)
1012
call ncdf_par_access(this,name=name,access=access)
1013
1013
end if
1014
1014
end subroutine ncdf_def_var_generic
1015
1015
subroutine ncdf_def_var_integer(this, name, type, dims, &
1016
atts, compress_lvl, shuffle, fill, &
1017
access, chunks)
1016
atts, compress_lvl, shuffle, fill, &
1017
access, chunks)
1018
1018
use dictionary
1019
1019
type(hNCDF), intent(inout) :: this
1020
1020
character(len=*), intent(in) :: name
1026
1026
integer, intent(in), optional :: access, chunks(:)
1027
1027
integer :: id
1028
1028
if ( .not. ncdf_participate(this) ) then
1029
! in case the attributes are present, we
1030
! still need to clean-up if asked
1031
if ( present(atts) ) then
1032
if ( 'ATT_DELETE' .in. atts ) then
1033
call delete(atts)
1034
end if
1035
end if
1036
return
1029
! in case the attributes are present, we
1030
! still need to clean-up if asked
1031
if ( present(atts) ) then
1032
if ( 'ATT_DELETE' .in. atts ) then
1033
call delete(atts)
1034
end if
1035
end if
1036
return
1037
1037
end if
1038
1038
call ncdf_def_var_generic(this, name, type, dims, id, &
1039
atts=atts, compress_lvl=compress_lvl, shuffle=shuffle, &
1040
access=access, chunks=chunks)
1039
atts=atts, compress_lvl=compress_lvl, shuffle=shuffle, &
1040
access=access, chunks=chunks)
1041
1041
if ( present(fill) ) then
1042
if ( fill ) then
1043
call ncdf_err(nf90_def_var_fill(this%id,id, 1, 0), &
1044
"Setting the variable "//trim(name)//" to NOFILL in file "//this)
1045
else
1046
call ncdf_err(nf90_def_var_fill(this%id,id, 0, 0), &
1047
"Setting the variable "//trim(name)//" to FILL in file "//this)
1048
end if
1042
if ( fill ) then
1043
call ncdf_err(nf90_def_var_fill(this%id,id, 1, 0), &
1044
"Setting the variable "//trim(name)//" to NOFILL in file "//this)
1045
else
1046
call ncdf_err(nf90_def_var_fill(this%id,id, 0, 0), &
1047
"Setting the variable "//trim(name)//" to FILL in file "//this)
1048
end if
1049
1049
end if
1050
1050
end subroutine ncdf_def_var_integer
1051
1051
subroutine ncdf_def_var_logical(this, name, type, dims, &
1052
atts, compress_lvl, shuffle, fill, &
1053
access, chunks)
1052
atts, compress_lvl, shuffle, fill, &
1053
access, chunks)
1054
1054
use dictionary
1055
1055
type(hNCDF), intent(inout) :: this
1056
1056
character(len=*), intent(in) :: name
1063
1063
integer :: id
1064
1064
integer :: ltype
1065
1065
if ( .not. ncdf_participate(this) ) then
1066
! in case the attributes are present, we
1067
! still need to clean-up if asked
1068
if ( present(atts) ) then
1069
if ( 'ATT_DELETE' .in. atts ) then
1070
call delete(atts)
1071
end if
1072
end if
1073
return
1074
end if
1075
if ( type .eqv. NF90_DOUBLE_COMPLEX ) then
1076
ltype = NF90_DOUBLE
1077
else
1078
ltype = NF90_FLOAT
1079
end if
1080
if ( type .eqv. NF90_DOUBLE_COMPLEX ) then
1081
ltype = NF90_DOUBLE
1082
else
1083
ltype = NF90_FLOAT
1066
! in case the attributes are present, we
1067
! still need to clean-up if asked
1068
if ( present(atts) ) then
1069
if ( 'ATT_DELETE' .in. atts ) then
1070
call delete(atts)
1071
end if
1072
end if
1073
return
1074
end if
1075
if ( type .eqv. NF90_DOUBLE_COMPLEX ) then
1076
ltype = NF90_DOUBLE
1077
else
1078
ltype = NF90_FLOAT
1079
end if
1080
if ( type .eqv. NF90_DOUBLE_COMPLEX ) then
1081
ltype = NF90_DOUBLE
1082
else
1083
ltype = NF90_FLOAT
1084
1084
end if
1085
1085
call ncdf_def_var_generic(this, "Re"//trim(name), ltype, dims, id, &
1086
atts=atts, compress_lvl=compress_lvl, shuffle=shuffle, &
1087
access=access, chunks=chunks)
1086
atts=atts, compress_lvl=compress_lvl, shuffle=shuffle, &
1087
access=access, chunks=chunks)
1088
1088
if ( present(fill) ) then
1089
if ( fill ) then
1090
call ncdf_err(nf90_def_var_fill(this%id,id, 1, 0), &
1091
"Setting the variable "//trim(name)//" to NOFILL in file "//this)
1092
else
1093
call ncdf_err(nf90_def_var_fill(this%id,id, 0, 0), &
1094
"Setting the variable "//trim(name)//" to FILL in file "//this)
1095
end if
1089
if ( fill ) then
1090
call ncdf_err(nf90_def_var_fill(this%id,id, 1, 0), &
1091
"Setting the variable "//trim(name)//" to NOFILL in file "//this)
1092
else
1093
call ncdf_err(nf90_def_var_fill(this%id,id, 0, 0), &
1094
"Setting the variable "//trim(name)//" to FILL in file "//this)
1095
end if
1096
1096
end if
1097
1097
call ncdf_def_var_generic(this, "Im"//trim(name), ltype, dims, id, &
1098
atts=atts, compress_lvl=compress_lvl, shuffle=shuffle, &
1099
access=access, chunks=chunks)
1098
atts=atts, compress_lvl=compress_lvl, shuffle=shuffle, &
1099
access=access, chunks=chunks)
1100
1100
if ( present(fill) ) then
1101
if ( fill ) then
1102
call ncdf_err(nf90_def_var_fill(this%id,id, 1, 0), &
1103
"Setting the variable "//trim(name)//" to NOFILL in file "//this)
1104
else
1105
call ncdf_err(nf90_def_var_fill(this%id,id, 0, 0), &
1106
"Setting the variable "//trim(name)//" to FILL in file "//this)
1107
end if
1101
if ( fill ) then
1102
call ncdf_err(nf90_def_var_fill(this%id,id, 1, 0), &
1103
"Setting the variable "//trim(name)//" to NOFILL in file "//this)
1104
else
1105
call ncdf_err(nf90_def_var_fill(this%id,id, 0, 0), &
1106
"Setting the variable "//trim(name)//" to FILL in file "//this)
1107
end if
1108
1108
end if
1109
1109
end subroutine ncdf_def_var_logical
1110
1110
subroutine ncdf_default(this,access,compress_lvl)
1132
1132
! The variable must exist
1133
1133
lexist = iret == NF90_NOERR
1134
1134
if ( present(exist) ) then
1135
exist = lexist
1135
exist = lexist
1136
1136
else if ( .not. lexist ) then
1137
call ncdf_err(iret,"Retrieving information about: "//trim(name)//" in file: "//this)
1137
call ncdf_err(iret,"Retrieving information about: "//trim(name)//" in file: "//this)
1138
1138
end if
1139
1139
! If there is nothing to inquire: return
1140
1140
if ( .not. lexist ) return
1141
1141
if ( present(id) ) id = lid
1142
1142
! If the user has requested information about the size of the variable...
1143
1143
if ( present(size) ) then
1144
call ncdf_err(nf90_inquire_variable(this%id, lid, ndims=nids, dimids=ldids))
1145
do i = 1 , min(nids,ubound(size,1))
1146
call ncdf_err(nf90_inquire_dimension(this%id,ldids(i),name=dim), &
1147
"Retrieving dimension name in inq_var for file: "//this)
1148
! Save the dimension size in array "size"
1149
call ncdf_inq_dim(this,trim(dim),len=size(i))
1150
end do
1144
call ncdf_err(nf90_inquire_variable(this%id, lid, ndims=nids, dimids=ldids))
1145
do i = 1 , min(nids,ubound(size,1))
1146
call ncdf_err(nf90_inquire_dimension(this%id,ldids(i),name=dim), &
1147
"Retrieving dimension name in inq_var for file: "//this)
1148
! Save the dimension size in array "size"
1149
call ncdf_inq_dim(this,trim(dim),len=size(i))
1150
end do
1151
1151
end if
1152
1152
! The user has requested information about the attributes associated...
1153
1153
if ( present(atts) ) then
1154
call get_atts_id(this,lid,atts=atts)
1154
call get_atts_id(this,lid,atts=atts)
1155
1155
end if
1156
1156
end subroutine ncdf_inq_var_def
1157
1157
subroutine ncdf_inq_dim(this,name,exist,id,len)
1168
1168
iret = nf90_inq_dimid(this%id, trim(name), lid)
1169
1169
lexist = iret == NF90_NOERR
1170
1170
if ( present(exist) ) then
1171
exist = lexist
1171
exist = lexist
1172
1172
else if ( .not. lexist ) then
1173
call ncdf_err(iret,"Retrieving information about: "//trim(name)//" in file: "//this)
1173
call ncdf_err(iret,"Retrieving information about: "//trim(name)//" in file: "//this)
1174
1174
end if
1175
1175
! If there is nothing to inquire: return
1176
1176
if ( .not. lexist ) return
1177
1177
if ( present(id) ) id = lid
1178
1178
if ( present(len) ) then
1179
call ncdf_err(nf90_inquire_dimension(this%id, lid, len=len), &
1180
"Retrieving length of dimension: "//trim(name)//" in file: "//this)
1179
call ncdf_err(nf90_inquire_dimension(this%id, lid, len=len), &
1180
"Retrieving length of dimension: "//trim(name)//" in file: "//this)
1181
1181
end if
1182
1182
end subroutine ncdf_inq_dim
1183
1183
subroutine ncdf_inq_gatt(this,name,exist,len,xtype)
1191
1191
if ( .not. ncdf_participate(this) ) return
1192
1192
! Figure out if the dimension exists
1193
1193
iret = nf90_inquire_attribute(this%id, NF90_GLOBAL, trim(name), &
1194
len = len, xtype = xtype)
1194
len = len, xtype = xtype)
1195
1195
lexist = iret == NF90_NOERR
1196
1196
if ( present(exist) ) then
1197
exist = lexist
1197
exist = lexist
1198
1198
else if ( .not. lexist ) then
1199
call ncdf_err(iret,"Retrieving information about: "//trim(name)//" in file: "//this)
1199
call ncdf_err(iret,"Retrieving information about: "//trim(name)//" in file: "//this)
1200
1200
end if
1201
1201
end subroutine ncdf_inq_gatt
1202
1202
subroutine ncdf_inq_att(this,var,name,exist,len,xtype)
1212
1212
call ncdf_inq_var(this,var,id=id)
1213
1213
! Figure out if the dimension exists
1214
1214
iret = nf90_inquire_attribute(this%id, id, trim(name), &
1215
len = len, xtype = xtype)
1215
len = len, xtype = xtype)
1216
1216
lexist = iret == NF90_NOERR
1217
1217
if ( present(exist) ) then
1218
exist = lexist
1218
exist = lexist
1219
1219
else if ( .not. lexist ) then
1220
call ncdf_err(iret,"Retrieving information about: "//trim(name)//" in file: "//this)
1220
call ncdf_err(iret,"Retrieving information about: "//trim(name)//" in file: "//this)
1221
1221
end if
1222
1222
end subroutine ncdf_inq_att
1223
1223
subroutine put_gatt(this,name,att,atts)
1229
1229
type(dict), optional, intent(inout) :: atts
1230
1230
if ( .not. ncdf_participate(this) ) return
1231
1231
if ( present(name) .and. present(att) ) then
1232
call put_att_id(this,NF90_GLOBAL,trim(name),att)
1232
call put_att_id(this,NF90_GLOBAL,trim(name),att)
1233
1233
else if ( present(atts) ) then
1234
call put_atts_id(this,NF90_GLOBAL,atts)
1234
call put_atts_id(this,NF90_GLOBAL,atts)
1235
1235
else
1236
call ncdf_err(-100, &
1237
'Programming error: put_gatt interface not properly populated')
1236
call ncdf_err(-100, &
1237
'Programming error: put_gatt interface not properly populated')
1238
1238
end if
1239
1239
end subroutine put_gatt
1240
1240
subroutine get_gatt(this,name,att,atts)
1246
1246
type(dict), optional, intent(inout) :: atts
1247
1247
if ( .not. ncdf_participate(this) ) return
1248
1248
if ( present(name) .and. present(att) ) then
1249
call get_att_id(this,NF90_GLOBAL,trim(name),att)
1249
call get_att_id(this,NF90_GLOBAL,trim(name),att)
1250
1250
else if ( present(atts) ) then
1251
call get_atts_id(this,NF90_GLOBAL,atts)
1251
call get_atts_id(this,NF90_GLOBAL,atts)
1252
1252
else
1253
call ncdf_err(-100, &
1254
'Programming error: get_gatt interface not properly populated')
1253
call ncdf_err(-100, &
1254
'Programming error: get_gatt interface not properly populated')
1255
1255
end if
1256
1256
end subroutine get_gatt
1257
1257
subroutine put_att(this,var,name,att,atts)
1266
1266
if ( .not. ncdf_participate(this) ) return
1267
1267
call ncdf_inq_var(this,var,id=ID)
1268
1268
if ( present(name) .and. present(att) ) then
1269
call put_att_id(this,ID,trim(name),att)
1269
call put_att_id(this,ID,trim(name),att)
1270
1270
else if ( present(atts) ) then
1271
call put_atts_id(this,ID,atts)
1271
call put_atts_id(this,ID,atts)
1272
1272
else
1273
call ncdf_err(-100, &
1274
'Programming error: put_att interface not properly populated')
1273
call ncdf_err(-100, &
1274
'Programming error: put_att interface not properly populated')
1275
1275
end if
1276
1276
end subroutine put_att
1277
1277
subroutine get_att(this,var,name,att,atts)
1286
1286
if ( .not. ncdf_participate(this) ) return
1287
1287
call ncdf_inq_var(this,var,id=ID)
1288
1288
if ( present(name) .and. present(att) ) then
1289
call get_att_id(this,ID,trim(name),att)
1289
call get_att_id(this,ID,trim(name),att)
1290
1290
else if ( present(atts) ) then
1291
call get_atts_id(this,ID,atts)
1291
call get_atts_id(this,ID,atts)
1292
1292
else
1293
call ncdf_err(-100, &
1294
'Programming error: get_att interface not properly populated')
1293
call ncdf_err(-100, &
1294
'Programming error: get_att interface not properly populated')
1295
1295
end if
1296
1296
end subroutine get_att
1297
1297
subroutine put_atts_id(this,id,atts)
1306
1306
if ( len(atts) == 0 ) return
1307
1307
att = .first. atts
1308
1308
att_loop: do
1309
if ( .empty. att ) exit att_loop
1310
key = .key. att
1311
if ( key == "ATT_DELETE" ) then
1312
att = .next. att
1313
cycle
1314
end if
1315
! we do not copy any data
1316
call associate(at_var,att)
1317
call put_att_id(this,id,trim(key),at_var)
1318
att = .next. att
1309
if ( .empty. att ) exit att_loop
1310
key = .key. att
1311
if ( key == "ATT_DELETE" ) then
1312
att = .next. att
1313
cycle
1314
end if
1315
! we do not copy any data
1316
call associate(at_var,att)
1317
call put_att_id(this,id,trim(key),at_var)
1318
att = .next. att
1319
1319
end do att_loop
1320
1320
! clean-up encoding
1321
1321
call nullify(at_var)
1322
1322
! If the user adds this key, the dictionary will be deleted
1323
1323
! after usage...
1324
1324
if ( "ATT_DELETE" .in. atts ) then
1325
call delete(atts)
1325
call delete(atts)
1326
1326
end if
1327
1327
end subroutine put_atts_id
1328
1328
subroutine put_att_id(this,id,name,att)
1340
1340
call ncdf_redef(this)
1341
1341
select case ( which(att) )
1342
1342
case ( 'a1' ) ! character array
1343
call assign(tmp,att)
1344
iret = nf90_put_att(this%id, id, trim(name), tmp)
1343
call assign(tmp,att)
1344
iret = nf90_put_att(this%id, id, trim(name), tmp)
1345
1345
case ( 'h0' )
1346
call associate(h0,att)
1347
iret = nf90_put_att(this%id, id, trim(name), h0)
1346
call associate(h0,att)
1347
iret = nf90_put_att(this%id, id, trim(name), h0)
1348
1348
case ( 'h1' )
1349
call associate(h1,att)
1350
iret = nf90_put_att(this%id, id, trim(name), h1)
1349
call associate(h1,att)
1350
iret = nf90_put_att(this%id, id, trim(name), h1)
1351
1351
case ( 'i0' )
1352
call associate(i0,att)
1353
iret = nf90_put_att(this%id, id, trim(name), i0)
1352
call associate(i0,att)
1353
iret = nf90_put_att(this%id, id, trim(name), i0)
1354
1354
case ( 'i1' )
1355
call associate(i1,att)
1356
iret = nf90_put_att(this%id, id, trim(name), i1)
1355
call associate(i1,att)
1356
iret = nf90_put_att(this%id, id, trim(name), i1)
1357
1357
case ( 's0' )
1358
call associate(s0,att)
1359
iret = nf90_put_att(this%id, id, trim(name), s0)
1358
call associate(s0,att)
1359
iret = nf90_put_att(this%id, id, trim(name), s0)
1360
1360
case ( 's1' )
1361
call associate(s1,att)
1362
iret = nf90_put_att(this%id, id, trim(name), s1)
1361
call associate(s1,att)
1362
iret = nf90_put_att(this%id, id, trim(name), s1)
1363
1363
case ( 'd0' )
1364
call associate(d0,att)
1365
iret = nf90_put_att(this%id, id, trim(name), d0)
1364
call associate(d0,att)
1365
iret = nf90_put_att(this%id, id, trim(name), d0)
1366
1366
case ( 'd1' )
1367
call associate(d1,att)
1368
iret = nf90_put_att(this%id, id, trim(name), d1)
1367
call associate(d1,att)
1368
iret = nf90_put_att(this%id, id, trim(name), d1)
1369
1369
case default
1370
iret = -100
1370
iret = -100
1371
1371
end select
1372
1372
call ncdf_err(iret, &
1373
"Saving attribute: "//trim(name)// &
1374
" in file: "//this)
1373
"Saving attribute: "//trim(name)// &
1374
" in file: "//this)
1375
1375
end subroutine put_att_id
1376
1376
subroutine get_atts_id(this,id,atts)
1377
1377
use dictionary
1383
1383
character(len=NF90_MAX_NAME) :: name
1384
1384
type(var) :: att
1385
1385
if ( id == NF90_GLOBAL ) then
1386
call ncdf_err(nf90_inquire(this%id, nAttributes=nAtts), &
1387
"Retrieving number of associated attributes in inquire for file: "//this)
1386
call ncdf_err(nf90_inquire(this%id, nAttributes=nAtts), &
1387
"Retrieving number of associated attributes in inquire for file: "//this)
1388
1388
else
1389
call ncdf_err(nf90_inquire_variable(this%id, id, nAtts=nAtts), &
1390
"Retrieving number of associated attributes in inq_var for file: "//this)
1389
call ncdf_err(nf90_inquire_variable(this%id, id, nAtts=nAtts), &
1390
"Retrieving number of associated attributes in inq_var for file: "//this)
1391
1391
end if
1392
1392
do i = 1 , nAtts
1393
name = ' '
1394
call ncdf_err(nf90_inq_attname(this%id, id, i, name), &
1395
"Retrieving the attribute name for file: "//this)
1396
call get_att_id(this,id,name,att)
1397
call extend(atts,(trim(name).kv.att))
1393
name = ' '
1394
call ncdf_err(nf90_inq_attname(this%id, id, i, name), &
1395
"Retrieving the attribute name for file: "//this)
1396
call get_att_id(this,id,name,att)
1397
call extend(atts,(trim(name).kv.att))
1398
1398
end do
1399
1399
call delete(att)
1400
1400
end subroutine get_atts_id
1406
1406
character(len=*), intent(in) :: name
1407
1407
type(var), intent(inout) :: att
1408
1408
integer :: xtype, att_len
1409
character(len=500) :: att_char
1409
character(len=512) :: att_char
1410
1410
real(sp), allocatable :: a_sp(:)
1411
1411
real(dp), allocatable :: a_dp(:)
1412
1412
integer(ih), allocatable :: a_ih(:)
1413
1413
integer(is), allocatable :: a_is(:)
1414
1414
! retrieve the attribute length and data-type
1415
1415
call ncdf_err(nf90_inquire_attribute(this%id,id,trim(name), &
1416
xtype=xtype,len=att_len),'Retriving inquire_attribute: '//this)
1416
xtype=xtype,len=att_len),'Retriving inquire_attribute: '//this)
1417
1417
select case ( xtype )
1418
1418
case ( NF90_CHAR )
1419
att_char = ' '
1420
call ncdf_err(nf90_get_att(this%id, id, trim(name), att_char), &
1421
"Retrieving the attribute value for file: "//this)
1422
call assign(att,trim(att_char))
1419
att_char = ' '
1420
call ncdf_err(nf90_get_att(this%id, id, trim(name), att_char), &
1421
"Retrieving the attribute value for file: "//this)
1422
call assign(att,trim(att_char))
1423
1423
case ( NF90_SHORT )
1424
allocate(a_ih(att_len))
1425
call ncdf_err(nf90_get_att(this%id, id, trim(name), a_ih), &
1426
"Retrieving the attribute value for file: "//this)
1427
if ( att_len == 1 ) then
1428
call assign(att,a_ih(1))
1429
else
1430
call assign(att,a_ih)
1431
end if
1432
deallocate(a_ih)
1424
allocate(a_ih(att_len))
1425
call ncdf_err(nf90_get_att(this%id, id, trim(name), a_ih), &
1426
"Retrieving the attribute value for file: "//this)
1427
if ( att_len == 1 ) then
1428
call assign(att,a_ih(1))
1429
else
1430
call assign(att,a_ih)
1431
end if
1432
deallocate(a_ih)
1433
1433
case ( NF90_INT )
1434
allocate(a_is(att_len))
1435
call ncdf_err(nf90_get_att(this%id, id, trim(name), a_is), &
1436
"Retrieving the attribute value for file: "//this)
1437
if ( att_len == 1 ) then
1438
call assign(att,a_is(1))
1439
else
1440
call assign(att,a_is)
1441
end if
1442
deallocate(a_is)
1434
allocate(a_is(att_len))
1435
call ncdf_err(nf90_get_att(this%id, id, trim(name), a_is), &
1436
"Retrieving the attribute value for file: "//this)
1437
if ( att_len == 1 ) then
1438
call assign(att,a_is(1))
1439
else
1440
call assign(att,a_is)
1441
end if
1442
deallocate(a_is)
1443
1443
case ( NF90_FLOAT )
1444
allocate(a_sp(att_len))
1445
call ncdf_err(nf90_get_att(this%id, id, trim(name), a_sp), &
1446
"Retrieving the attribute value for file: "//this)
1447
if ( att_len == 1 ) then
1448
call assign(att,a_sp(1))
1449
else
1450
call assign(att,a_sp)
1451
end if
1452
deallocate(a_sp)
1444
allocate(a_sp(att_len))
1445
call ncdf_err(nf90_get_att(this%id, id, trim(name), a_sp), &
1446
"Retrieving the attribute value for file: "//this)
1447
if ( att_len == 1 ) then
1448
call assign(att,a_sp(1))
1449
else
1450
call assign(att,a_sp)
1451
end if
1452
deallocate(a_sp)
1453
1453
case ( NF90_DOUBLE )
1454
allocate(a_dp(att_len))
1455
call ncdf_err(nf90_get_att(this%id, id, trim(name), a_dp), &
1456
"Retrieving the attribute value for file: "//this)
1457
if ( att_len == 1 ) then
1458
call assign(att,a_dp(1))
1459
else
1460
call assign(att,a_dp)
1461
end if
1462
deallocate(a_dp)
1454
allocate(a_dp(att_len))
1455
call ncdf_err(nf90_get_att(this%id, id, trim(name), a_dp), &
1456
"Retrieving the attribute value for file: "//this)
1457
if ( att_len == 1 ) then
1458
call assign(att,a_dp(1))
1459
else
1460
call assign(att,a_dp)
1461
end if
1462
deallocate(a_dp)
1463
1463
end select
1464
1464
end subroutine get_att_id
1465
1465
! Delete attributes
1475
1475
! Figure out if the dimension exists
1476
1476
iret = nf90_inquire_attribute(this%id, id, trim(name))
1477
1477
if ( iret == NF90_NOERR ) then
1478
call ncdf_err(nf90_del_att(this%id, id, trim(name)), &
1479
"Deleting attribute: "//trim(name)//" for variable "//&
1480
trim(var)//" in file: "//this)
1478
call ncdf_err(nf90_del_att(this%id, id, trim(name)), &
1479
"Deleting attribute: "//trim(name)//" for variable "//&
1480
trim(var)//" in file: "//this)
1481
1481
end if
1482
1482
end subroutine ncdf_del_att
1483
1483
subroutine ncdf_del_gatt(this,name)
1490
1490
! Figure out if the dimension exists
1491
1491
iret = nf90_inquire_attribute(this%id, NF90_GLOBAL, trim(name))
1492
1492
if ( iret == NF90_NOERR ) then
1493
call ncdf_err(nf90_del_att(this%id, NF90_GLOBAL, trim(name)), &
1494
"Deleting global attribute: "//trim(name)//" in file: "//this)
1493
call ncdf_err(nf90_del_att(this%id, NF90_GLOBAL, trim(name)), &
1494
"Deleting global attribute: "//trim(name)//" in file: "//this)
1495
1495
end if
1496
1496
end subroutine ncdf_del_gatt
1497
1497
subroutine ncdf_fill(this,fill,old_fill)
1503
1503
lf = NF90_NOFILL
1504
1504
if ( present(fill) ) lf = fill
1505
1505
call ncdf_err(nf90_set_fill(this%id,lf, lof), &
1506
"Setting fill mode in file: "//this)
1506
"Setting fill mode in file: "//this)
1507
1507
if ( present(old_fill) ) old_fill = lof
1508
1508
if ( .not. present(fill) ) &
1509
call ncdf_err(nf90_set_fill(this%id,lof, lf), &
1510
"Re-setting fill mode in file: "//this)
1509
call ncdf_err(nf90_set_fill(this%id,lof, lf), &
1510
"Re-setting fill mode in file: "//this)
1511
1511
end subroutine ncdf_fill
1512
! Use the ncdf.sh script to generate the needed code...
1512
! Use the ncdf.sh script to generate the needed code...
1513
1513
subroutine put_var_h0_name(this,name,var,start,count)
1514
1514
type(hNCDF), intent(inout) :: this
1515
1515
character(len=*), intent(in) :: name
1576
1576
subroutine put_var_h1_name(this,name,var,start,count)
1577
1577
type(hNCDF), intent(inout) :: this
1578
1578
character(len=*), intent(in) :: name
1579
integer(ih), intent(in), dimension(:) :: var
1579
integer(ih), intent(in) :: var (:)
1580
1580
integer, intent(in), optional :: start(:)
1581
1581
integer, intent(in), optional :: count(:)
1582
1582
integer :: id
1589
1589
subroutine get_var_h1_name(this, name, var, start, count, stride)
1590
1590
type(hNCDF), intent(inout) :: this
1591
1591
character(len=*), intent(in) :: name
1592
integer(ih), intent(out), dimension(:) :: var
1592
integer(ih), intent(out) :: var (:)
1593
1593
integer, intent(in), optional :: start(:)
1594
1594
integer, intent(in), optional :: count(:)
1595
1595
integer, intent(in), optional :: stride(:)
1603
1603
subroutine put_var_h2_name(this,name,var,start,count)
1604
1604
type(hNCDF), intent(inout) :: this
1605
1605
character(len=*), intent(in) :: name
1606
integer(ih), intent(in), dimension(:,:) :: var
1606
integer(ih), intent(in) :: var (:,:)
1607
1607
integer, intent(in), optional :: start(:)
1608
1608
integer, intent(in), optional :: count(:)
1609
1609
integer :: id
1616
1616
subroutine get_var_h2_name(this, name, var, start, count, stride)
1617
1617
type(hNCDF), intent(inout) :: this
1618
1618
character(len=*), intent(in) :: name
1619
integer(ih), intent(out), dimension(:,:) :: var
1619
integer(ih), intent(out) :: var (:,:)
1620
1620
integer, intent(in), optional :: start(:)
1621
1621
integer, intent(in), optional :: count(:)
1622
1622
integer, intent(in), optional :: stride(:)
1630
1630
subroutine put_var_h3_name(this,name,var,start,count)
1631
1631
type(hNCDF), intent(inout) :: this
1632
1632
character(len=*), intent(in) :: name
1633
integer(ih), intent(in), dimension(:,:,:) :: var
1633
integer(ih), intent(in) :: var (:,:,:)
1634
1634
integer, intent(in), optional :: start(:)
1635
1635
integer, intent(in), optional :: count(:)
1636
1636
integer :: id
1643
1643
subroutine get_var_h3_name(this, name, var, start, count, stride)
1644
1644
type(hNCDF), intent(inout) :: this
1645
1645
character(len=*), intent(in) :: name
1646
integer(ih), intent(out), dimension(:,:,:) :: var
1646
integer(ih), intent(out) :: var (:,:,:)
1647
1647
integer, intent(in), optional :: start(:)
1648
1648
integer, intent(in), optional :: count(:)
1649
1649
integer, intent(in), optional :: stride(:)
1760
1760
subroutine put_gatt_s1(this, name, att)
1761
1761
type(hNCDF), intent(inout) :: this
1762
1762
character(len=*), intent(in) :: name
1763
real(sp), intent(in), dimension(:) :: att
1763
real(sp), intent(in) :: att (:)
1764
1764
if ( .not. ncdf_participate(this) ) return
1765
1765
if (this%define > -1 ) call ncdf_redef(this)
1766
1766
call ncdf_err(nf90_put_att(this%id, NF90_GLOBAL, name, att), &
1769
1769
subroutine put_att_s1(this, var, name, att)
1770
1770
type(hNCDF), intent(inout) :: this
1771
1771
character(len=*), intent(in) :: var, name
1772
real(sp), intent(in), dimension(:) :: att
1772
real(sp), intent(in) :: att (:)
1773
1773
integer :: id
1774
1774
if ( .not. ncdf_participate(this) ) return
1775
1775
if (this%define > -1 ) call ncdf_redef(this)
1781
1781
subroutine get_att_s1(this, var, name, att)
1782
1782
type(hNCDF), intent(inout) :: this
1783
1783
character(len=*), intent(in) :: var, name
1784
real(sp), intent(out), dimension(:) :: att
1784
real(sp), intent(out) :: att (:)
1785
1785
integer :: id
1786
1786
if ( .not. ncdf_participate(this) ) return
1787
1787
call ncdf_err(nf90_inq_varid(this%id, trim(var), id), &
1792
1792
subroutine get_gatt_s1(this, name, att)
1793
1793
type(hNCDF), intent(inout) :: this
1794
1794
character(len=*), intent(in) :: name
1795
real(sp), intent(out), dimension(:) :: att
1795
real(sp), intent(out) :: att (:)
1796
1796
if ( .not. ncdf_participate(this) ) return
1797
1797
call ncdf_err(nf90_get_att(this%id, NF90_GLOBAL, name, att), &
1798
1798
'Saving global (VAR) attribute: '//trim(name)//' in file: '//this)
1800
1800
subroutine put_var_s1_name(this,name,var,start,count)
1801
1801
type(hNCDF), intent(inout) :: this
1802
1802
character(len=*), intent(in) :: name
1803
real(sp), intent(in), dimension(:) :: var
1803
real(sp), intent(in) :: var (:)
1804
1804
integer, intent(in), optional :: start(:)
1805
1805
integer, intent(in), optional :: count(:)
1806
1806
integer :: id
1813
1813
subroutine get_var_s1_name(this, name, var, start, count, stride)
1814
1814
type(hNCDF), intent(inout) :: this
1815
1815
character(len=*), intent(in) :: name
1816
real(sp), intent(out), dimension(:) :: var
1816
real(sp), intent(out) :: var (:)
1817
1817
integer, intent(in), optional :: start(:)
1818
1818
integer, intent(in), optional :: count(:)
1819
1819
integer, intent(in), optional :: stride(:)
1827
1827
subroutine put_var_s2_name(this,name,var,start,count)
1828
1828
type(hNCDF), intent(inout) :: this
1829
1829
character(len=*), intent(in) :: name
1830
real(sp), intent(in), dimension(:,:) :: var
1830
real(sp), intent(in) :: var (:,:)
1831
1831
integer, intent(in), optional :: start(:)
1832
1832
integer, intent(in), optional :: count(:)
1833
1833
integer :: id
1840
1840
subroutine get_var_s2_name(this, name, var, start, count, stride)
1841
1841
type(hNCDF), intent(inout) :: this
1842
1842
character(len=*), intent(in) :: name
1843
real(sp), intent(out), dimension(:,:) :: var
1843
real(sp), intent(out) :: var (:,:)
1844
1844
integer, intent(in), optional :: start(:)
1845
1845
integer, intent(in), optional :: count(:)
1846
1846
integer, intent(in), optional :: stride(:)
1854
1854
subroutine put_var_s3_name(this,name,var,start,count)
1855
1855
type(hNCDF), intent(inout) :: this
1856
1856
character(len=*), intent(in) :: name
1857
real(sp), intent(in), dimension(:,:,:) :: var
1857
real(sp), intent(in) :: var (:,:,:)
1858
1858
integer, intent(in), optional :: start(:)
1859
1859
integer, intent(in), optional :: count(:)
1860
1860
integer :: id
1867
1867
subroutine get_var_s3_name(this, name, var, start, count, stride)
1868
1868
type(hNCDF), intent(inout) :: this
1869
1869
character(len=*), intent(in) :: name
1870
real(sp), intent(out), dimension(:,:,:) :: var
1870
real(sp), intent(out) :: var (:,:,:)
1871
1871
integer, intent(in), optional :: start(:)
1872
1872
integer, intent(in), optional :: count(:)
1873
1873
integer, intent(in), optional :: stride(:)
1984
1984
subroutine put_gatt_d1(this, name, att)
1985
1985
type(hNCDF), intent(inout) :: this
1986
1986
character(len=*), intent(in) :: name
1987
real(dp), intent(in), dimension(:) :: att
1987
real(dp), intent(in) :: att (:)
1988
1988
if ( .not. ncdf_participate(this) ) return
1989
1989
if (this%define > -1 ) call ncdf_redef(this)
1990
1990
call ncdf_err(nf90_put_att(this%id, NF90_GLOBAL, name, att), &
1993
1993
subroutine put_att_d1(this, var, name, att)
1994
1994
type(hNCDF), intent(inout) :: this
1995
1995
character(len=*), intent(in) :: var, name
1996
real(dp), intent(in), dimension(:) :: att
1996
real(dp), intent(in) :: att (:)
1997
1997
integer :: id
1998
1998
if ( .not. ncdf_participate(this) ) return
1999
1999
if (this%define > -1 ) call ncdf_redef(this)
2005
2005
subroutine get_att_d1(this, var, name, att)
2006
2006
type(hNCDF), intent(inout) :: this
2007
2007
character(len=*), intent(in) :: var, name
2008
real(dp), intent(out), dimension(:) :: att
2008
real(dp), intent(out) :: att (:)
2009
2009
integer :: id
2010
2010
if ( .not. ncdf_participate(this) ) return
2011
2011
call ncdf_err(nf90_inq_varid(this%id, trim(var), id), &
2016
2016
subroutine get_gatt_d1(this, name, att)
2017
2017
type(hNCDF), intent(inout) :: this
2018
2018
character(len=*), intent(in) :: name
2019
real(dp), intent(out), dimension(:) :: att
2019
real(dp), intent(out) :: att (:)
2020
2020
if ( .not. ncdf_participate(this) ) return
2021
2021
call ncdf_err(nf90_get_att(this%id, NF90_GLOBAL, name, att), &
2022
2022
'Saving global (VAR) attribute: '//trim(name)//' in file: '//this)
2024
2024
subroutine put_var_d1_name(this,name,var,start,count)
2025
2025
type(hNCDF), intent(inout) :: this
2026
2026
character(len=*), intent(in) :: name
2027
real(dp), intent(in), dimension(:) :: var
2027
real(dp), intent(in) :: var (:)
2028
2028
integer, intent(in), optional :: start(:)
2029
2029
integer, intent(in), optional :: count(:)
2030
2030
integer :: id
2037
2037
subroutine get_var_d1_name(this, name, var, start, count, stride)
2038
2038
type(hNCDF), intent(inout) :: this
2039
2039
character(len=*), intent(in) :: name
2040
real(dp), intent(out), dimension(:) :: var
2040
real(dp), intent(out) :: var (:)
2041
2041
integer, intent(in), optional :: start(:)
2042
2042
integer, intent(in), optional :: count(:)
2043
2043
integer, intent(in), optional :: stride(:)
2051
2051
subroutine put_var_d2_name(this,name,var,start,count)
2052
2052
type(hNCDF), intent(inout) :: this
2053
2053
character(len=*), intent(in) :: name
2054
real(dp), intent(in), dimension(:,:) :: var
2054
real(dp), intent(in) :: var (:,:)
2055
2055
integer, intent(in), optional :: start(:)
2056
2056
integer, intent(in), optional :: count(:)
2057
2057
integer :: id
2064
2064
subroutine get_var_d2_name(this, name, var, start, count, stride)
2065
2065
type(hNCDF), intent(inout) :: this
2066
2066
character(len=*), intent(in) :: name
2067
real(dp), intent(out), dimension(:,:) :: var
2067
real(dp), intent(out) :: var (:,:)
2068
2068
integer, intent(in), optional :: start(:)
2069
2069
integer, intent(in), optional :: count(:)
2070
2070
integer, intent(in), optional :: stride(:)
2078
2078
subroutine put_var_d3_name(this,name,var,start,count)
2079
2079
type(hNCDF), intent(inout) :: this
2080
2080
character(len=*), intent(in) :: name
2081
real(dp), intent(in), dimension(:,:,:) :: var
2081
real(dp), intent(in) :: var (:,:,:)
2082
2082
integer, intent(in), optional :: start(:)
2083
2083
integer, intent(in), optional :: count(:)
2084
2084
integer :: id
2091
2091
subroutine get_var_d3_name(this, name, var, start, count, stride)
2092
2092
type(hNCDF), intent(inout) :: this
2093
2093
character(len=*), intent(in) :: name
2094
real(dp), intent(out), dimension(:,:,:) :: var
2094
real(dp), intent(out) :: var (:,:,:)
2095
2095
integer, intent(in), optional :: start(:)
2096
2096
integer, intent(in), optional :: count(:)
2097
2097
integer, intent(in), optional :: stride(:)
2138
2138
call ncdf_inq_var(this,name,id=id,fill=lfill,fill_val=lfill_val)
2139
2139
if ( present(fill) ) lfill = fill
2140
2140
lfill_val = fill_val
2141
lr = real(lfill_val)
2141
lr = real(lfill_val, sp)
2142
2142
call ncdf_err(nf90_def_var_fill(this%id, id(1), lfill, tmp_lr), &
2143
2143
'Setting fill (VAR) Re'//trim(name)//' in file: '//this)
2144
2144
lr = aimag(lfill_val)
2178
2178
end if
2179
2179
end if
2180
2180
! if ( present(fill_val) ) then
2181
!fill_val = cmplx(lfill_valr,lfill_valc)
2182
fill_val = cmplx(0.,0.)
2181
!fill_val = cmplx(lfill_valr,lfill_valc, sp)
2182
fill_val = cmplx(0,0, sp)
2183
2183
! end if
2184
2184
end subroutine inq_var_c0
2185
2185
subroutine put_var_c1_name(this,name,var,start,count)
2186
2186
type(hNCDF), intent(inout) :: this
2187
2187
character(len=*), intent(in) :: name
2188
complex(sp), intent(in), dimension(:) :: var
2188
complex(sp), intent(in) :: var (:)
2189
2189
integer, intent(in), optional :: start(:)
2190
2190
integer, intent(in), optional :: count(:)
2191
2191
integer :: id
2192
real(sp), allocatable , dimension(:) :: r
2192
real(sp), allocatable :: r (:)
2193
2193
if ( .not. ncdf_participate(this) ) return
2194
2194
if ( this%define > -1 ) call ncdf_enddef(this)
2195
2195
allocate(r(size(var)))
2196
r = real(var)
2196
r (:) = real(var, sp)
2197
2197
call ncdf_inq_var(this,'Re'//name,id=id)
2198
2198
call ncdf_err(nf90_put_var(this%id, id, r,start=start,count=count), &
2199
2199
"Saving variable (VAR) Re"//trim(name)//' in file: '//this)
2200
2200
call ncdf_inq_var(this,'Im'//name,id=id)
2201
r = aimag(var)
2201
r (:) = aimag(var)
2202
2202
call ncdf_err(nf90_put_var(this%id, id, r,start=start,count=count), &
2203
2203
'Saving variable (VAR) Im'//trim(name)//' in file: '//this)
2204
2204
deallocate(r)
2206
2206
subroutine get_var_c1_name(this, name, var, start, count, stride)
2207
2207
type(hNCDF), intent(inout) :: this
2208
2208
character(len=*), intent(in) :: name
2209
complex(sp), intent(out), dimension(:) :: var
2209
complex(sp), intent(out) :: var (:)
2210
2210
integer, intent(in), optional :: start(:)
2211
2211
integer, intent(in), optional :: count(:)
2212
2212
integer, intent(in), optional :: stride(:)
2213
2213
integer :: id
2214
real(sp), allocatable , dimension(:) :: r,i
2214
real(sp), allocatable :: r (:) , i (:)
2215
2215
if ( .not. ncdf_participate(this) ) return
2216
2216
if ( this%define > -1 ) call ncdf_enddef(this)
2217
2217
allocate(r(size(var)))
2222
2222
call ncdf_inq_var(this,'Im'//name,id=id)
2223
2223
call ncdf_err(nf90_get_var(this%id, id, i,start=start,count=count,stride=stride), &
2224
2224
'Retrieving variable (VAR) Im'//trim(name)//' in file: '//this)
2225
var = cmplx(r,i)
2225
var (:) = cmplx(r,i, sp)
2226
2226
deallocate(r,i)
2227
2227
end subroutine get_var_c1_name
2228
2228
subroutine put_var_c2_name(this,name,var,start,count)
2229
2229
type(hNCDF), intent(inout) :: this
2230
2230
character(len=*), intent(in) :: name
2231
complex(sp), intent(in), dimension(:,:) :: var
2231
complex(sp), intent(in) :: var (:,:)
2232
2232
integer, intent(in), optional :: start(:)
2233
2233
integer, intent(in), optional :: count(:)
2234
2234
integer :: id
2235
real(sp), allocatable , dimension(:,:) :: r
2235
real(sp), allocatable :: r (:,:)
2236
2236
if ( .not. ncdf_participate(this) ) return
2237
2237
if ( this%define > -1 ) call ncdf_enddef(this)
2238
2238
allocate(r(size(var,1),size(var,2)))
2239
r = real(var)
2239
r (:,:) = real(var, sp)
2240
2240
call ncdf_inq_var(this,'Re'//name,id=id)
2241
2241
call ncdf_err(nf90_put_var(this%id, id, r,start=start,count=count), &
2242
2242
"Saving variable (VAR) Re"//trim(name)//' in file: '//this)
2243
2243
call ncdf_inq_var(this,'Im'//name,id=id)
2244
r = aimag(var)
2244
r (:,:) = aimag(var)
2245
2245
call ncdf_err(nf90_put_var(this%id, id, r,start=start,count=count), &
2246
2246
'Saving variable (VAR) Im'//trim(name)//' in file: '//this)
2247
2247
deallocate(r)
2249
2249
subroutine get_var_c2_name(this, name, var, start, count, stride)
2250
2250
type(hNCDF), intent(inout) :: this
2251
2251
character(len=*), intent(in) :: name
2252
complex(sp), intent(out), dimension(:,:) :: var
2252
complex(sp), intent(out) :: var (:,:)
2253
2253
integer, intent(in), optional :: start(:)
2254
2254
integer, intent(in), optional :: count(:)
2255
2255
integer, intent(in), optional :: stride(:)
2256
2256
integer :: id
2257
real(sp), allocatable , dimension(:,:) :: r,i
2257
real(sp), allocatable :: r (:,:) , i (:,:)
2258
2258
if ( .not. ncdf_participate(this) ) return
2259
2259
if ( this%define > -1 ) call ncdf_enddef(this)
2260
2260
allocate(r(size(var,1),size(var,2)))
2265
2265
call ncdf_inq_var(this,'Im'//name,id=id)
2266
2266
call ncdf_err(nf90_get_var(this%id, id, i,start=start,count=count,stride=stride), &
2267
2267
'Retrieving variable (VAR) Im'//trim(name)//' in file: '//this)
2268
var = cmplx(r,i)
2268
var (:,:) = cmplx(r,i, sp)
2269
2269
deallocate(r,i)
2270
2270
end subroutine get_var_c2_name
2271
2271
subroutine put_var_c3_name(this,name,var,start,count)
2272
2272
type(hNCDF), intent(inout) :: this
2273
2273
character(len=*), intent(in) :: name
2274
complex(sp), intent(in), dimension(:,:,:) :: var
2274
complex(sp), intent(in) :: var (:,:,:)
2275
2275
integer, intent(in), optional :: start(:)
2276
2276
integer, intent(in), optional :: count(:)
2277
2277
integer :: id
2278
real(sp), allocatable , dimension(:,:,:) :: r
2278
real(sp), allocatable :: r (:,:,:)
2279
2279
if ( .not. ncdf_participate(this) ) return
2280
2280
if ( this%define > -1 ) call ncdf_enddef(this)
2281
2281
allocate(r(size(var,1),size(var,2),size(var,3)))
2282
r = real(var)
2282
r (:,:,:) = real(var, sp)
2283
2283
call ncdf_inq_var(this,'Re'//name,id=id)
2284
2284
call ncdf_err(nf90_put_var(this%id, id, r,start=start,count=count), &
2285
2285
"Saving variable (VAR) Re"//trim(name)//' in file: '//this)
2286
2286
call ncdf_inq_var(this,'Im'//name,id=id)
2287
r = aimag(var)
2287
r (:,:,:) = aimag(var)
2288
2288
call ncdf_err(nf90_put_var(this%id, id, r,start=start,count=count), &
2289
2289
'Saving variable (VAR) Im'//trim(name)//' in file: '//this)
2290
2290
deallocate(r)
2292
2292
subroutine get_var_c3_name(this, name, var, start, count, stride)
2293
2293
type(hNCDF), intent(inout) :: this
2294
2294
character(len=*), intent(in) :: name
2295
complex(sp), intent(out), dimension(:,:,:) :: var
2295
complex(sp), intent(out) :: var (:,:,:)
2296
2296
integer, intent(in), optional :: start(:)
2297
2297
integer, intent(in), optional :: count(:)
2298
2298
integer, intent(in), optional :: stride(:)
2299
2299
integer :: id
2300
real(sp), allocatable , dimension(:,:,:) :: r,i
2300
real(sp), allocatable :: r (:,:,:) , i (:,:,:)
2301
2301
if ( .not. ncdf_participate(this) ) return
2302
2302
if ( this%define > -1 ) call ncdf_enddef(this)
2303
2303
allocate(r(size(var,1),size(var,2),size(var,3)))
2308
2308
call ncdf_inq_var(this,'Im'//name,id=id)
2309
2309
call ncdf_err(nf90_get_var(this%id, id, i,start=start,count=count,stride=stride), &
2310
2310
'Retrieving variable (VAR) Im'//trim(name)//' in file: '//this)
2311
var = cmplx(r,i)
2311
var (:,:,:) = cmplx(r,i, sp)
2312
2312
deallocate(r,i)
2313
2313
end subroutine get_var_c3_name
2314
2314
subroutine put_var_z0_name(this,name,var,start,count)
2347
2347
call ncdf_inq_var(this,name,id=id,fill=lfill,fill_val=lfill_val)
2348
2348
if ( present(fill) ) lfill = fill
2349
2349
lfill_val = fill_val
2350
lr = real(lfill_val)
2350
lr = real(lfill_val, dp)
2351
2351
call ncdf_err(nf90_def_var_fill(this%id, id(1), lfill, tmp_lr), &
2352
2352
'Setting fill (VAR) Re'//trim(name)//' in file: '//this)
2353
2353
lr = aimag(lfill_val)
2387
2387
end if
2388
2388
end if
2389
2389
! if ( present(fill_val) ) then
2390
!fill_val = cmplx(lfill_valr,lfill_valc)
2391
fill_val = cmplx(0.,0.)
2390
!fill_val = cmplx(lfill_valr,lfill_valc, dp)
2391
fill_val = cmplx(0,0, dp)
2392
2392
! end if
2393
2393
end subroutine inq_var_z0
2394
2394
subroutine put_var_z1_name(this,name,var,start,count)
2395
2395
type(hNCDF), intent(inout) :: this
2396
2396
character(len=*), intent(in) :: name
2397
complex(dp), intent(in), dimension(:) :: var
2397
complex(dp), intent(in) :: var (:)
2398
2398
integer, intent(in), optional :: start(:)
2399
2399
integer, intent(in), optional :: count(:)
2400
2400
integer :: id
2401
real(dp), allocatable , dimension(:) :: r
2401
real(dp), allocatable :: r (:)
2402
2402
if ( .not. ncdf_participate(this) ) return
2403
2403
if ( this%define > -1 ) call ncdf_enddef(this)
2404
2404
allocate(r(size(var)))
2405
r = real(var)
2405
r (:) = real(var, dp)
2406
2406
call ncdf_inq_var(this,'Re'//name,id=id)
2407
2407
call ncdf_err(nf90_put_var(this%id, id, r,start=start,count=count), &
2408
2408
"Saving variable (VAR) Re"//trim(name)//' in file: '//this)
2409
2409
call ncdf_inq_var(this,'Im'//name,id=id)
2410
r = aimag(var)
2410
r (:) = aimag(var)
2411
2411
call ncdf_err(nf90_put_var(this%id, id, r,start=start,count=count), &
2412
2412
'Saving variable (VAR) Im'//trim(name)//' in file: '//this)
2413
2413
deallocate(r)
2415
2415
subroutine get_var_z1_name(this, name, var, start, count, stride)
2416
2416
type(hNCDF), intent(inout) :: this
2417
2417
character(len=*), intent(in) :: name
2418
complex(dp), intent(out), dimension(:) :: var
2418
complex(dp), intent(out) :: var (:)
2419
2419
integer, intent(in), optional :: start(:)
2420
2420
integer, intent(in), optional :: count(:)
2421
2421
integer, intent(in), optional :: stride(:)
2422
2422
integer :: id
2423
real(dp), allocatable , dimension(:) :: r,i
2423
real(dp), allocatable :: r (:) , i (:)
2424
2424
if ( .not. ncdf_participate(this) ) return
2425
2425
if ( this%define > -1 ) call ncdf_enddef(this)
2426
2426
allocate(r(size(var)))
2431
2431
call ncdf_inq_var(this,'Im'//name,id=id)
2432
2432
call ncdf_err(nf90_get_var(this%id, id, i,start=start,count=count,stride=stride), &
2433
2433
'Retrieving variable (VAR) Im'//trim(name)//' in file: '//this)
2434
var = cmplx(r,i)
2434
var (:) = cmplx(r,i, dp)
2435
2435
deallocate(r,i)
2436
2436
end subroutine get_var_z1_name
2437
2437
subroutine put_var_z2_name(this,name,var,start,count)
2438
2438
type(hNCDF), intent(inout) :: this
2439
2439
character(len=*), intent(in) :: name
2440
complex(dp), intent(in), dimension(:,:) :: var
2440
complex(dp), intent(in) :: var (:,:)
2441
2441
integer, intent(in), optional :: start(:)
2442
2442
integer, intent(in), optional :: count(:)
2443
2443
integer :: id
2444
real(dp), allocatable , dimension(:,:) :: r
2444
real(dp), allocatable :: r (:,:)
2445
2445
if ( .not. ncdf_participate(this) ) return
2446
2446
if ( this%define > -1 ) call ncdf_enddef(this)
2447
2447
allocate(r(size(var,1),size(var,2)))
2448
r = real(var)
2448
r (:,:) = real(var, dp)
2449
2449
call ncdf_inq_var(this,'Re'//name,id=id)
2450
2450
call ncdf_err(nf90_put_var(this%id, id, r,start=start,count=count), &
2451
2451
"Saving variable (VAR) Re"//trim(name)//' in file: '//this)
2452
2452
call ncdf_inq_var(this,'Im'//name,id=id)
2453
r = aimag(var)
2453
r (:,:) = aimag(var)
2454
2454
call ncdf_err(nf90_put_var(this%id, id, r,start=start,count=count), &
2455
2455
'Saving variable (VAR) Im'//trim(name)//' in file: '//this)
2456
2456
deallocate(r)
2458
2458
subroutine get_var_z2_name(this, name, var, start, count, stride)
2459
2459
type(hNCDF), intent(inout) :: this
2460
2460
character(len=*), intent(in) :: name
2461
complex(dp), intent(out), dimension(:,:) :: var
2461
complex(dp), intent(out) :: var (:,:)
2462
2462
integer, intent(in), optional :: start(:)
2463
2463
integer, intent(in), optional :: count(:)
2464
2464
integer, intent(in), optional :: stride(:)
2465
2465
integer :: id
2466
real(dp), allocatable , dimension(:,:) :: r,i
2466
real(dp), allocatable :: r (:,:) , i (:,:)
2467
2467
if ( .not. ncdf_participate(this) ) return
2468
2468
if ( this%define > -1 ) call ncdf_enddef(this)
2469
2469
allocate(r(size(var,1),size(var,2)))
2474
2474
call ncdf_inq_var(this,'Im'//name,id=id)
2475
2475
call ncdf_err(nf90_get_var(this%id, id, i,start=start,count=count,stride=stride), &
2476
2476
'Retrieving variable (VAR) Im'//trim(name)//' in file: '//this)
2477
var = cmplx(r,i)
2477
var (:,:) = cmplx(r,i, dp)
2478
2478
deallocate(r,i)
2479
2479
end subroutine get_var_z2_name
2480
2480
subroutine put_var_z3_name(this,name,var,start,count)
2481
2481
type(hNCDF), intent(inout) :: this
2482
2482
character(len=*), intent(in) :: name
2483
complex(dp), intent(in), dimension(:,:,:) :: var
2483
complex(dp), intent(in) :: var (:,:,:)
2484
2484
integer, intent(in), optional :: start(:)
2485
2485
integer, intent(in), optional :: count(:)
2486
2486
integer :: id
2487
real(dp), allocatable , dimension(:,:,:) :: r
2487
real(dp), allocatable :: r (:,:,:)
2488
2488
if ( .not. ncdf_participate(this) ) return
2489
2489
if ( this%define > -1 ) call ncdf_enddef(this)
2490
2490
allocate(r(size(var,1),size(var,2),size(var,3)))
2491
r = real(var)
2491
r (:,:,:) = real(var, dp)
2492
2492
call ncdf_inq_var(this,'Re'//name,id=id)
2493
2493
call ncdf_err(nf90_put_var(this%id, id, r,start=start,count=count), &
2494
2494
"Saving variable (VAR) Re"//trim(name)//' in file: '//this)
2495
2495
call ncdf_inq_var(this,'Im'//name,id=id)
2496
r = aimag(var)
2496
r (:,:,:) = aimag(var)
2497
2497
call ncdf_err(nf90_put_var(this%id, id, r,start=start,count=count), &
2498
2498
'Saving variable (VAR) Im'//trim(name)//' in file: '//this)
2499
2499
deallocate(r)
2501
2501
subroutine get_var_z3_name(this, name, var, start, count, stride)
2502
2502
type(hNCDF), intent(inout) :: this
2503
2503
character(len=*), intent(in) :: name
2504
complex(dp), intent(out), dimension(:,:,:) :: var
2504
complex(dp), intent(out) :: var (:,:,:)
2505
2505
integer, intent(in), optional :: start(:)
2506
2506
integer, intent(in), optional :: count(:)
2507
2507
integer, intent(in), optional :: stride(:)
2508
2508
integer :: id
2509
real(dp), allocatable , dimension(:,:,:) :: r,i
2509
real(dp), allocatable :: r (:,:,:) , i (:,:,:)
2510
2510
if ( .not. ncdf_participate(this) ) return
2511
2511
if ( this%define > -1 ) call ncdf_enddef(this)
2512
2512
allocate(r(size(var,1),size(var,2),size(var,3)))
2517
2517
call ncdf_inq_var(this,'Im'//name,id=id)
2518
2518
call ncdf_err(nf90_get_var(this%id, id, i,start=start,count=count,stride=stride), &
2519
2519
'Retrieving variable (VAR) Im'//trim(name)//' in file: '//this)
2520
var = cmplx(r,i)
2520
var (:,:,:) = cmplx(r,i, dp)
2521
2521
deallocate(r,i)
2522
2522
end subroutine get_var_z3_name
2523
2523
subroutine put_gatt_i0(this, name, att)
2626
2626
subroutine put_gatt_i1(this, name, att)
2627
2627
type(hNCDF), intent(inout) :: this
2628
2628
character(len=*), intent(in) :: name
2629
integer(is), intent(in), dimension(:) :: att
2629
integer(is), intent(in) :: att (:)
2630
2630
if ( .not. ncdf_participate(this) ) return
2631
2631
if (this%define > -1 ) call ncdf_redef(this)
2632
2632
call ncdf_err(nf90_put_att(this%id, NF90_GLOBAL, name, att), &
2635
2635
subroutine put_att_i1(this, var, name, att)
2636
2636
type(hNCDF), intent(inout) :: this
2637
2637
character(len=*), intent(in) :: var, name
2638
integer(is), intent(in), dimension(:) :: att
2638
integer(is), intent(in) :: att (:)
2639
2639
integer :: id
2640
2640
if ( .not. ncdf_participate(this) ) return
2641
2641
if (this%define > -1 ) call ncdf_redef(this)
2647
2647
subroutine get_att_i1(this, var, name, att)
2648
2648
type(hNCDF), intent(inout) :: this
2649
2649
character(len=*), intent(in) :: var, name
2650
integer(is), intent(out), dimension(:) :: att
2650
integer(is), intent(out) :: att (:)
2651
2651
integer :: id
2652
2652
if ( .not. ncdf_participate(this) ) return
2653
2653
call ncdf_err(nf90_inq_varid(this%id, trim(var), id), &
2658
2658
subroutine get_gatt_i1(this, name, att)
2659
2659
type(hNCDF), intent(inout) :: this
2660
2660
character(len=*), intent(in) :: name
2661
integer(is), intent(out), dimension(:) :: att
2661
integer(is), intent(out) :: att (:)
2662
2662
if ( .not. ncdf_participate(this) ) return
2663
2663
call ncdf_err(nf90_get_att(this%id, NF90_GLOBAL, name, att), &
2664
2664
'Saving global (VAR) attribute: '//trim(name)//' in file: '//this)
2666
2666
subroutine put_var_i1_name(this,name,var,start,count)
2667
2667
type(hNCDF), intent(inout) :: this
2668
2668
character(len=*), intent(in) :: name
2669
integer(is), intent(in), dimension(:) :: var
2669
integer(is), intent(in) :: var (:)
2670
2670
integer, intent(in), optional :: start(:)
2671
2671
integer, intent(in), optional :: count(:)
2672
2672
integer :: id
2679
2679
subroutine get_var_i1_name(this, name, var, start, count, stride)
2680
2680
type(hNCDF), intent(inout) :: this
2681
2681
character(len=*), intent(in) :: name
2682
integer(is), intent(out), dimension(:) :: var
2682
integer(is), intent(out) :: var (:)
2683
2683
integer, intent(in), optional :: start(:)
2684
2684
integer, intent(in), optional :: count(:)
2685
2685
integer, intent(in), optional :: stride(:)
2693
2693
subroutine put_var_i2_name(this,name,var,start,count)
2694
2694
type(hNCDF), intent(inout) :: this
2695
2695
character(len=*), intent(in) :: name
2696
integer(is), intent(in), dimension(:,:) :: var
2696
integer(is), intent(in) :: var (:,:)
2697
2697
integer, intent(in), optional :: start(:)
2698
2698
integer, intent(in), optional :: count(:)
2699
2699
integer :: id
2706
2706
subroutine get_var_i2_name(this, name, var, start, count, stride)
2707
2707
type(hNCDF), intent(inout) :: this
2708
2708
character(len=*), intent(in) :: name
2709
integer(is), intent(out), dimension(:,:) :: var
2709
integer(is), intent(out) :: var (:,:)
2710
2710
integer, intent(in), optional :: start(:)
2711
2711
integer, intent(in), optional :: count(:)
2712
2712
integer, intent(in), optional :: stride(:)
2720
2720
subroutine put_var_i3_name(this,name,var,start,count)
2721
2721
type(hNCDF), intent(inout) :: this
2722
2722
character(len=*), intent(in) :: name
2723
integer(is), intent(in), dimension(:,:,:) :: var
2723
integer(is), intent(in) :: var (:,:,:)
2724
2724
integer, intent(in), optional :: start(:)
2725
2725
integer, intent(in), optional :: count(:)
2726
2726
integer :: id
2733
2733
subroutine get_var_i3_name(this, name, var, start, count, stride)
2734
2734
type(hNCDF), intent(inout) :: this
2735
2735
character(len=*), intent(in) :: name
2736
integer(is), intent(out), dimension(:,:,:) :: var
2736
integer(is), intent(out) :: var (:,:,:)
2737
2737
integer, intent(in), optional :: start(:)
2738
2738
integer, intent(in), optional :: count(:)
2739
2739
integer, intent(in), optional :: stride(:)
2756
2756
i = nf90_enddef(this%id)
2757
2757
if ( i == nf90_noerr ) return
2758
2758
if ( i == nf90_enotindefine ) then
2759
! we pass, the not-in-define mode
2760
! just tells us that we are already in data-mode
2761
return
2759
! we pass, the not-in-define mode
2760
! just tells us that we are already in data-mode
2761
return
2762
2762
end if
2763
2763
call ncdf_err(i,"End definition segment of file: "//this)
2764
2764
end subroutine ncdf_enddef
2768
2768
if ( this%define == 0 ) return
2769
2769
if ( .not. ncdf_participate(this) ) return
2770
2770
call ncdf_err(nf90_sync(this%f_id), &
2771
"File syncronization for file"//this)
2771
"File syncronization for file"//this)
2772
2772
end subroutine ncdf_sync
2773
2773
subroutine ncdf_redef(this)
2774
2774
type(hNCDF), intent(inout) :: this
2780
2780
i = nf90_redef(this%id)
2781
2781
if ( i == nf90_noerr ) return
2782
2782
if ( i == nf90_eindefine ) then
2783
! we pass, the in-define mode
2784
! just tells us that we are already in define-mode
2785
return
2783
! we pass, the in-define mode
2784
! just tells us that we are already in define-mode
2785
return
2786
2786
end if
2787
2787
call ncdf_err(i,"Redef definition segment in file: "//this)
2788
2788
end subroutine ncdf_redef
2789
!"#############################################################"
2790
!"##############" Specialized routines for handling"#########"
2791
!"#########" the different aspects of this module"###########"
2792
!"#############################################################"
2793
! A simple error checker for NetCDF
2789
!"#############################################################"
2790
!"##############" Specialized routines for handling"#########"
2791
!"#########" the different aspects of this module"###########"
2792
!"#############################################################"
2793
! A simple error checker for NetCDF
2794
2794
subroutine ncdf_err(status,msg)
2795
2795
integer, intent(in) :: status
2796
2796
character(len=*), optional, intent(in) :: msg
2798
2798
! reading or writing of the NetCDF handle...
2799
2799
! if ( .not. ncdf_participate() ) return
2800
2800
if (status .ne. nf90_noerr) then
2801
if (present(msg)) write(*,"(a)") trim(msg)
2802
write(*,*)
2803
write(*,"(a)") "Error occured in NCDF:"
2804
write(0,"(a)") "Error occured in NCDF:"
2805
select case ( status )
2806
case ( -130 ) ! include/netcdf.h:"define" NC_ECANTEXTEND (-130)
2807
! < Attempt to extend dataset during ind. I/O operation. >!
2808
write(*,"(a)") 'Attempt to extend (UNLIMITED dimension) a parallel file in INDEPENDENT ACCESS mode'
2809
write(0,"(a)") 'Attempt to extend (UNLIMITED dimension) a parallel file in INDEPENDENT ACCESS mode'
2810
case default
2811
write(*,"(a)") trim(nf90_strerror(status))
2812
write(0,"(a)") trim(nf90_strerror(status))
2813
end select
2814
write(*,"(a,tr1,i0)") "Status number:",status
2815
write(0,"(a,tr1,i0)") "Status number:",status
2816
call ncdf_die("Stopped due to error in NetCDF file")
2801
if (present(msg)) write(*,"(a)") trim(msg)
2802
write(*,*)
2803
write(*,"(a)") "Error occured in NCDF:"
2804
write(0,"(a)") "Error occured in NCDF:"
2805
select case ( status )
2806
case ( -130 ) ! include/netcdf.h:"define" NC_ECANTEXTEND (-130)
2807
! < Attempt to extend dataset during ind. I/O operation. >!
2808
write(*,"(a)") 'Attempt to extend (UNLIMITED dimension) a parallel file in INDEPENDENT ACCESS mode'
2809
write(0,"(a)") 'Attempt to extend (UNLIMITED dimension) a parallel file in INDEPENDENT ACCESS mode'
2810
case default
2811
write(*,"(a)") trim(nf90_strerror(status))
2812
write(0,"(a)") trim(nf90_strerror(status))
2813
end select
2814
write(*,"(a,tr1,i0)") "Status number:",status
2815
write(0,"(a,tr1,i0)") "Status number:",status
2816
call ncdf_die("Stopped due to error in NetCDF file")
2817
2817
endif
2818
2818
end subroutine ncdf_err
2819
!"#############################################################"
2820
!"#############" Routines for handling the groups"############"
2821
!"#########" of the NetCDF files. We allow this to"##########"
2822
!"#########" always be present due to reduction of"##########"
2823
!"###############" preprocessor flags"#######################"
2824
!"#############################################################"
2819
!"#############################################################"
2820
!"#############" Routines for handling the groups"############"
2821
!"#########" of the NetCDF files. We allow this to"##########"
2822
!"#########" always be present due to reduction of"##########"
2823
!"###############" preprocessor flags"#######################"
2824
!"#############################################################"
2825
2825
! Create groups in a NetCDF4 file
2826
2826
subroutine ncdf_def_grp(this,name,grp)
2827
2827
type(hNCDF), intent(in out) :: this
2836
2836
grp%grp = trim(grp%grp)//"/"//trim(name)
2837
2837
! Create the group and return
2838
2838
call ncdf_err(nf90_def_grp(this%id,name,grp%id), &
2839
"Creating group "//trim(name)//" in file "//this)
2839
"Creating group "//trim(name)//" in file "//this)
2840
2840
end subroutine ncdf_def_grp
2841
2841
! Open a group from an existing file
2842
2842
subroutine ncdf_open_grp(this,name,grp)
2853
2853
! Find the group and return
2854
2854
call ncdf_err(nf90_inq_grp_full_ncid(grp%f_id, trim(grp%grp), grp%id))
2855
2855
end subroutine ncdf_open_grp
2856
!"#############################################################"
2857
!"###############" End of group routines"####################"
2858
!"#############################################################"
2859
!" Returns" a logical determining the participation of the node
2856
!"#############################################################"
2857
!"###############" End of group routines"####################"
2858
!"#############################################################"
2859
!" Returns" a logical determining the participation of the node
2860
2860
function ncdf_participate(this) result(participate)
2861
2861
type(hNCDF), intent(in) :: this
2862
2862
logical :: participate
2865
2865
! If a communicator is attached the parallel flag is also set
2866
2866
participate = this%parallel .or. IONode
2867
2867
end function ncdf_participate
2868
! These routines or functions are global available even if the NetCDF is not used...
2869
! functions for concatenating strings and ncdf handles.
2868
! These routines or functions are global available even if the NetCDF is not used...
2869
! functions for concatenating strings and ncdf handles.
2870
2870
function cat_char_ncdf(char,this) result(cat)
2871
2871
character(len=*), intent(in) :: char
2872
2872
type(hNCDF), intent(in) :: this
2893
2893
! This will fail if it is not the 0th Node in the communicator
2894
2894
! For instance a subgroup in the Comm_World...
2895
2895
if ( Node == 0 ) then
2896
write(*,"(a20,a)") "NetCDF filename: ",trim(this%name)
2897
if ( len_trim(this%grp) /= 0 ) then
2898
write(*,"(a20,a)") "NetCDF group name: ",trim(this%grp)
2899
end if
2900
write(*,"(a20,i7)") "NetCDF ID: ",this%id
2901
if ( this%parallel ) then
2902
write(*,"(a20,a)") "Parallel access: ","True"
2903
write(*,"(a20,tr1,i0)") "Parallel processors:",Nodes
2904
else
2905
write(*,"(a20,a)") "Parallel access: ","False"
2906
end if
2907
if ( this%define == 0 ) then
2908
write(*,"(a20,a)") "In define-mode: ","True"
2909
else if ( this%define == 1 ) then
2910
write(*,"(a20,a)") "In define-mode: ","False"
2911
end if
2912
call ncdf_inq(this, dims=ndims, vars=nvars, atts=ngatts, &
2896
write(*,"(a20,a)") "NetCDF filename: ",trim(this%name)
2897
if ( len_trim(this%grp) /= 0 ) then
2898
write(*,"(a20,a)") "NetCDF group name: ",trim(this%grp)
2899
end if
2900
write(*,"(a20,i7)") "NetCDF ID: ",this%id
2901
if ( this%parallel ) then
2902
write(*,"(a20,a)") "Parallel access: ","True"
2903
write(*,"(a20,tr1,i0)") "Parallel processors:",Nodes
2904
else
2905
write(*,"(a20,a)") "Parallel access: ","False"
2906
end if
2907
if ( this%define == 0 ) then
2908
write(*,"(a20,a)") "In define-mode: ","True"
2909
else if ( this%define == 1 ) then
2910
write(*,"(a20,a)") "In define-mode: ","False"
2911
end if
2912
if ( this%f_id >= 0 ) then
2913
call ncdf_inq(this, dims=ndims, vars=nvars, atts=ngatts, &
2913
2914
grps=ngrps, format=file_format)
2914
select case ( file_format )
2915
case ( NF90_FORMAT_CLASSIC )
2915
select case ( file_format )
2916
case ( NF90_FORMAT_CLASSIC )
2916
2917
write(*,"(a20,a)") "File format: ","Classic"
2917
case ( NF90_FORMAT_64BIT )
2918
case ( NF90_FORMAT_64BIT )
2918
2919
write(*,"(a20,a)") "File format: ","Classic 64Bit"
2919
case ( NF90_FORMAT_NETCDF4 )
2920
case ( NF90_FORMAT_NETCDF4 )
2920
2921
write(*,"(a20,a)") "File format: ","NetCDF4"
2921
2922
write(*,"(a20,i7)")"Default compression:",this%comp_lvl
2922
case ( NF90_FORMAT_NETCDF4_CLASSIC )
2923
case ( NF90_FORMAT_NETCDF4_CLASSIC )
2923
2924
write(*,"(a20,a)") "File format: ","NetCDF4 Classic format"
2924
2925
write(*,"(a22,i7)")"Default compression: ",this%comp_lvl
2925
case default
2926
case default
2926
2927
write(*,"(a20,a)") "File format: ","Could not be determined"
2927
end select
2928
write(*,"(a20,i7)") "Number of dimensions: ",ndims
2929
write(*,"(a20,i7)") "Number of variables: ",nvars
2930
write(*,"(a20,i7)") "Number of attributes: ",ngatts
2931
if ( ngrps >= 0 ) then
2932
write(*,"(a20,i7)") "Number of groups: ",ngrps
2933
end if
2934
if ( iand(NF90_WRITE,this%mode) == NF90_WRITE ) &
2928
end select
2929
write(*,"(a20,i7)") "Number of dimensions: ",ndims
2930
write(*,"(a20,i7)") "Number of variables: ",nvars
2931
write(*,"(a20,i7)") "Number of attributes: ",ngatts
2932
if ( ngrps >= 0 ) then
2933
write(*,"(a20,i7)") "Number of groups: ",ngrps
2934
end if
2935
end if
2936
if ( iand(NF90_WRITE,this%mode) == NF90_WRITE ) &
2935
2937
write(*,"(a20,a)") "NetCDF mode: ","NF90_WRITE"
2936
if ( iand(NF90_NOCLOBBER,this%mode) == NF90_NOCLOBBER ) then
2938
if ( iand(NF90_NOCLOBBER,this%mode) == NF90_NOCLOBBER ) then
2937
2939
write(*,"(a20,a)") "NetCDF mode: ","NF90_NOCLOBBER"
2938
else
2940
else
2939
2941
write(*,"(a20,a)") "NetCDF mode: ","NF90_CLOBBER"
2940
end if
2941
if ( iand(NF90_NOFILL,this%mode) == NF90_NOFILL ) &
2942
write(*,"(a20,a)") "NetCDF mode: ","NF90_NOFILL"
2943
if ( iand(NF90_64BIT_OFFSET,this%mode) == NF90_64BIT_OFFSET ) &
2944
write(*,"(a20,a)") "NetCDF mode: ","NF90_64BIT_OFFSET"
2945
if ( iand(NF90_LOCK,this%mode) == NF90_LOCK ) &
2946
write(*,"(a20,a)") "NetCDF mode: ","NF90_LOCK"
2947
if ( iand(NF90_SHARE,this%mode) == NF90_SHARE ) &
2948
write(*,"(a20,a)") "NetCDF mode: ","NF90_SHARE"
2949
if ( iand(NF90_NETCDF4,this%mode) == NF90_NETCDF4 ) &
2950
write(*,"(a20,a)") "NetCDF mode: ","NF90_NETCDF4"
2951
if ( iand(NF90_CLASSIC_MODEL,this%mode) == NF90_CLASSIC_MODEL ) &
2952
write(*,"(a20,a)") "NetCDF mode: ","NF90_CLASSIC_MODEL"
2942
end if
2943
if ( iand(NF90_NOFILL,this%mode) == NF90_NOFILL ) &
2944
write(*,"(a20,a)") "NetCDF mode: ","NF90_NOFILL"
2945
if ( iand(NF90_64BIT_OFFSET,this%mode) == NF90_64BIT_OFFSET ) &
2946
write(*,"(a20,a)") "NetCDF mode: ","NF90_64BIT_OFFSET"
2947
if ( iand(NF90_LOCK,this%mode) == NF90_LOCK ) &
2948
write(*,"(a20,a)") "NetCDF mode: ","NF90_LOCK"
2949
if ( iand(NF90_SHARE,this%mode) == NF90_SHARE ) &
2950
write(*,"(a20,a)") "NetCDF mode: ","NF90_SHARE"
2951
if ( iand(NF90_NETCDF4,this%mode) == NF90_NETCDF4 ) &
2952
write(*,"(a20,a)") "NetCDF mode: ","NF90_NETCDF4"
2953
if ( iand(NF90_CLASSIC_MODEL,this%mode) == NF90_CLASSIC_MODEL ) &
2954
write(*,"(a20,a)") "NetCDF mode: ","NF90_CLASSIC_MODEL"
2953
2955
end if
2954
2956
end subroutine ncdf_print
2955
! A standard die routine... It is not pretty... But it works...
2956
! Recommended to be adapted!
2957
! A standard die routine... It is not pretty... But it works...
2958
! Recommended to be adapted!
2957
2959
subroutine ncdf_die(str)
2958
2960
character(len=*), intent(in) :: str
2959
2961
write(0,"(2a)") 'ncdf: ',trim(str)
Loggerhead is a web-based interface for Breezy
Version: 2.0.1