38 PRIVATE :: nxupreparedata, nxuconfirmdata, nxusearchgroup
40 INTEGER,
PRIVATE :: nxcompress_type = nx_comp_none
41 INTEGER,
PRIVATE :: nxcompress_size = 1000
42 INTEGER,
PRIVATE :: group_level
43 INTEGER,
PRIVATE :: nxrank, nxdims(nx_maxrank), nxtype, nxsize
67 TYPE(nxhandle),
INTENT(in) :: file_id
68 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: user, affiliation, address, &
72 IF (present(user))
THEN
73 status =
nxputattr(file_id,
"user", trim(user))
74 IF (status /= nx_ok) return
76 IF (present(affiliation))
THEN
77 status =
nxputattr(file_id,
"affiliation", trim(affiliation))
78 IF (status /= nx_ok) return
80 IF (present(address))
THEN
81 status =
nxputattr(file_id,
"address", trim(address))
82 IF (status /= nx_ok) return
84 IF (present(phone))
THEN
85 status =
nxputattr(file_id,
"telephone_number", trim(phone))
86 IF (status /= nx_ok) return
88 IF (present(fax))
THEN
89 status =
nxputattr(file_id,
"fax_number", trim(fax))
90 IF (status /= nx_ok) return
92 IF (present(email))
THEN
93 status =
nxputattr(file_id,
"email", trim(email))
94 IF (status /= nx_ok) return
102 TYPE(nxhandle),
INTENT(in) :: file_id
103 CHARACTER(len=*),
INTENT(in) :: group_name, group_class
106 status =
nxmakegroup(file_id, group_name, group_class)
107 IF (status == nx_ok)
THEN
108 status =
nxopengroup(file_id, group_name, group_class)
118 FUNCTION nxuwritei4 (file_id, data_name, data, units) RESULT (status)
120 TYPE(nxhandle),
INTENT(inout) :: file_id
121 CHARACTER(len=*),
INTENT(in) :: data_name
122 INTEGER(kind=NXi4),
INTENT(in) :: data
123 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: units
126 status = nxupreparedata(file_id, data_name, nx_int32, 1, (/1/))
127 IF (status /= nx_ok) return
128 IF (present(units) .AND.
nxufindattr(file_id,
"units") == nx_eod)
THEN
129 status =
nxputattr(file_id,
"units", units)
130 IF (status /= nx_ok) return
137 FUNCTION nxuwriter4 (file_id, data_name, data, units) RESULT (status)
139 TYPE(nxhandle),
INTENT(inout) :: file_id
140 CHARACTER(len=*),
INTENT(in) :: data_name
141 REAL(kind=NXr4),
INTENT(in) :: data
142 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: units
145 status = nxupreparedata(file_id, data_name, nx_float32, 1, (/1/))
146 IF (status /= nx_ok) return
147 IF (present(units) .AND.
nxufindattr(file_id,
"units") == nx_eod)
THEN
148 status =
nxputattr(file_id,
"units", units)
149 IF (status /= nx_ok) return
156 FUNCTION nxuwriter8 (file_id, data_name, data, units) RESULT (status)
158 TYPE(nxhandle),
INTENT(inout) :: file_id
159 CHARACTER(len=*),
INTENT(in) :: data_name
160 REAL(kind=NXr8),
INTENT(in) :: data
161 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: units
164 status = nxupreparedata(file_id, data_name, nx_float64, 1, (/1/))
165 IF (status /= nx_ok) return
166 IF (present(units) .AND.
nxufindattr(file_id,
"units") == nx_eod)
THEN
167 status =
nxputattr(file_id,
"units", units)
168 IF (status /= nx_ok) return
175 FUNCTION nxuwritechar (file_id, data_name, data, units) RESULT (status)
177 TYPE(nxhandle),
INTENT(inout) :: file_id
178 CHARACTER(len=*),
INTENT(in) :: data_name
179 CHARACTER(len=*),
INTENT(in) :: data
180 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: units
183 status = nxupreparedata(file_id, data_name, nx_char, 1, &
185 IF (status /= nx_ok) return
186 IF (present(units) .AND.
nxufindattr(file_id,
"units") == nx_eod)
THEN
187 status =
nxputattr(file_id,
"units", units, len_trim(units), nx_char)
188 IF (status /= nx_ok) return
196 data_size) result(status)
198 TYPE(nxhandle),
INTENT(inout) :: file_id
199 CHARACTER(len=*),
INTENT(in) :: data_name
200 INTEGER(kind=NXi4),
INTENT(in) :: data(:)
201 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: units
202 INTEGER,
INTENT(in),
OPTIONAL :: data_start(:), data_size(:)
205 status = nxupreparedata(file_id, data_name, nx_int32, 1, (/
size(data)/))
206 IF (status /= nx_ok) return
207 IF (present(units) .AND.
nxufindattr(file_id,
"units") == nx_eod)
THEN
208 status =
nxputattr(file_id,
"units", units)
209 IF (status /= nx_ok) return
211 IF (present(data_start) .AND. present(data_size))
THEN
212 status =
nxputslab(file_id,
data, data_start, data_size)
221 data_size) result(status)
223 TYPE(nxhandle),
INTENT(inout) :: file_id
224 CHARACTER(len=*),
INTENT(in) :: data_name
225 REAL(kind=NXr4),
INTENT(in) :: data(:)
226 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: units
227 INTEGER,
INTENT(in),
OPTIONAL :: data_start(:), data_size(:)
230 status = nxupreparedata(file_id, data_name, nx_float32, 1, &
232 IF (status /= nx_ok) return
233 IF (present(units) .AND.
nxufindattr(file_id,
"units") == nx_eod)
THEN
234 status =
nxputattr(file_id,
"units", units)
235 IF (status /= nx_ok) return
237 IF (present(data_start) .AND. present(data_size))
THEN
238 status =
nxputslab(file_id,
data, data_start, data_size)
247 data_size) result(status)
249 TYPE(nxhandle),
INTENT(inout) :: file_id
250 CHARACTER(len=*),
INTENT(in) :: data_name
251 REAL(kind=NXr8),
INTENT(in) :: data(:)
252 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: units
253 INTEGER,
INTENT(in),
OPTIONAL :: data_start(:), data_size(:)
256 status = nxupreparedata(file_id, data_name, nx_float64, 1, &
258 IF (status /= nx_ok) return
259 IF (present(units) .AND.
nxufindattr(file_id,
"units") == nx_eod)
THEN
260 status =
nxputattr(file_id,
"units", units)
261 IF (status /= nx_ok) return
263 IF (present(data_start) .AND. present(data_size))
THEN
264 status =
nxputslab(file_id,
data, data_start, data_size)
273 data_size) result(status)
275 TYPE(nxhandle),
INTENT(inout) :: file_id
276 CHARACTER(len=*),
INTENT(in) :: data_name
277 INTEGER(kind=NXi4),
INTENT(in) :: data(:,:)
278 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: units
279 INTEGER,
INTENT(in),
OPTIONAL :: data_start(:), data_size(:)
281 INTEGER,
ALLOCATABLE :: buffer(:)
283 status = nxupreparedata(file_id, data_name, nx_int32, 2, shape(data))
284 IF (status /= nx_ok) return
285 IF (present(units) .AND.
nxufindattr(file_id,
"units") == nx_eod)
THEN
286 status =
nxputattr(file_id,
"units", units)
287 IF (status /= nx_ok) return
289 ALLOCATE (buffer(
size(data)))
290 buffer = reshape(
data, (/
size(data) /))
291 IF (present(data_start) .AND. present(data_size))
THEN
292 status =
nxputslab(file_id, buffer, data_start, data_size)
302 data_size) result(status)
304 TYPE(nxhandle),
INTENT(inout) :: file_id
305 CHARACTER(len=*),
INTENT(in) :: data_name
306 REAL(kind=NXr4),
INTENT(in) :: data(:,:)
307 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: units
308 INTEGER,
INTENT(in),
OPTIONAL :: data_start(:), data_size(:)
310 REAL(kind=NXr4),
ALLOCATABLE :: buffer(:)
312 status = nxupreparedata(file_id, data_name, nx_float32, 2, shape(data))
313 IF (status /= nx_ok) return
314 IF (present(units) .AND.
nxufindattr(file_id,
"units") == nx_eod)
THEN
315 status =
nxputattr(file_id,
"units", units)
316 IF (status /= nx_ok) return
318 ALLOCATE (buffer(
size(data)))
319 buffer = reshape(
data, (/
size(data) /))
320 IF (present(data_start) .AND. present(data_size))
THEN
321 status =
nxputslab(file_id, buffer, data_start, data_size)
331 data_size) result(status)
333 TYPE(nxhandle),
INTENT(inout) :: file_id
334 CHARACTER(len=*),
INTENT(in) :: data_name
335 REAL(kind=NXr8),
INTENT(in) :: data(:,:)
336 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: units
337 INTEGER,
INTENT(in),
OPTIONAL :: data_start(:), data_size(:)
339 REAL(kind=NXr8),
ALLOCATABLE :: buffer(:)
341 status = nxupreparedata(file_id, data_name, nx_float64, 2, shape(data))
342 IF (status /= nx_ok) return
343 IF (present(units) .AND.
nxufindattr(file_id,
"units") == nx_eod)
THEN
344 status =
nxputattr(file_id,
"units", units)
345 IF (status /= nx_ok) return
347 ALLOCATE (buffer(
size(data)))
348 buffer = reshape(
data, (/
size(data) /))
349 IF (present(data_start) .AND. present(data_size))
THEN
350 status =
nxputslab(file_id, buffer, data_start, data_size)
360 data_size) result(status)
362 TYPE(nxhandle),
INTENT(inout) :: file_id
363 CHARACTER(len=*),
INTENT(in) :: data_name
364 INTEGER(kind=NXi4),
INTENT(in) :: data(:,:,:)
365 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: units
366 INTEGER,
INTENT(in),
OPTIONAL :: data_start(:), data_size(:)
368 INTEGER,
ALLOCATABLE :: buffer(:)
370 status = nxupreparedata(file_id, data_name, nx_int32, 3, shape(data))
371 IF (status /= nx_ok) return
372 IF (present(units) .AND.
nxufindattr(file_id,
"units") == nx_eod)
THEN
373 status =
nxputattr(file_id,
"units", units)
374 IF (status /= nx_ok) return
376 ALLOCATE (buffer(
size(data)))
377 buffer = reshape(
data, (/
size(data) /))
378 IF (present(data_start) .AND. present(data_size))
THEN
379 status =
nxputslab(file_id, buffer, data_start, data_size)
389 data_size) result(status)
391 TYPE(nxhandle),
INTENT(inout) :: file_id
392 CHARACTER(len=*),
INTENT(in) :: data_name
393 REAL(kind=NXr4),
INTENT(in) :: data(:,:,:)
394 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: units
395 INTEGER,
INTENT(in),
OPTIONAL :: data_start(:), data_size(:)
397 REAL(kind=NXr4),
ALLOCATABLE :: buffer(:)
399 status = nxupreparedata(file_id, data_name, nx_float32, 3, shape(data))
400 IF (status /= nx_ok) return
401 IF (present(units) .AND.
nxufindattr(file_id,
"units") == nx_eod)
THEN
402 status =
nxputattr(file_id,
"units", units)
403 IF (status /= nx_ok) return
405 ALLOCATE (buffer(
size(data)))
406 buffer = reshape(
data, (/
size(data) /))
407 IF (present(data_start) .AND. present(data_size))
THEN
408 status =
nxputslab(file_id, buffer, data_start, data_size)
418 data_size) result(status)
420 TYPE(nxhandle),
INTENT(inout) :: file_id
421 CHARACTER(len=*),
INTENT(in) :: data_name
422 REAL(kind=NXr8),
INTENT(in) :: data(:,:,:)
423 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: units
424 INTEGER,
INTENT(in),
OPTIONAL :: data_start(:), data_size(:)
426 REAL(kind=NXr8),
ALLOCATABLE :: buffer(:)
428 status = nxupreparedata(file_id, data_name, nx_float64, 3, shape(data))
429 IF (status /= nx_ok) return
430 IF (present(units) .AND.
nxufindattr(file_id,
"units") == nx_eod)
THEN
431 status =
nxputattr(file_id,
"units", units)
432 IF (status /= nx_ok) return
434 ALLOCATE (buffer(
size(data)))
435 buffer = reshape(
data, (/
size(data) /))
436 IF (present(data_start) .AND. present(data_size))
THEN
437 status =
nxputslab(file_id, buffer, data_start, data_size)
450 FUNCTION nxureadi4 (file_id, data_name, data, units) RESULT (status)
452 TYPE(nxhandle),
INTENT(inout) :: file_id
453 CHARACTER(len=*),
INTENT(in) :: data_name
454 INTEGER(kind=NXi4),
INTENT(out) :: data
455 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: units
456 INTEGER :: status, dimensions(nx_maxrank)
457 INTEGER(kind=NXi4) :: buffer(1)
459 status = nxuconfirmdata(file_id, data_name, nx_int32, 1, dimensions)
460 IF (status /= nx_ok) return
461 IF (dimensions(1) /= 1)
THEN
466 IF (status == nx_ok)
THEN
468 IF (present(units))
THEN
469 status =
nxgetattr(file_id,
"units", units)
476 FUNCTION nxureadr4 (file_id, data_name, data, units) RESULT (status)
478 TYPE(nxhandle),
INTENT(inout) :: file_id
479 CHARACTER(len=*),
INTENT(in) :: data_name
480 REAL(kind=NXr4),
INTENT(out) :: data
481 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: units
482 INTEGER :: status, dimensions(nx_maxrank)
483 REAL(kind=NXr4) :: buffer(1)
485 status = nxuconfirmdata(file_id, data_name, nx_float32, 1, dimensions)
486 IF (status /= nx_ok) return
487 IF (dimensions(1) /= 1)
THEN
492 IF (status == nx_ok)
THEN
494 IF (present(units))
THEN
495 status =
nxgetattr(file_id,
"units", units)
502 FUNCTION nxureadr8 (file_id, data_name, data, units) RESULT (status)
504 TYPE(nxhandle),
INTENT(inout) :: file_id
505 CHARACTER(len=*),
INTENT(in) :: data_name
506 REAL(kind=NXr8),
INTENT(out) :: data
507 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: units
508 INTEGER :: status, dimensions(nx_maxrank)
509 REAL(kind=NXr8) :: buffer(1)
511 status = nxuconfirmdata(file_id, data_name, nx_float64, 1, dimensions)
512 IF (status /= nx_ok) return
513 IF (dimensions(1) /= 1)
THEN
518 IF (status == nx_ok)
THEN
520 IF (present(units))
THEN
521 status =
nxgetattr(file_id,
"units", units)
528 FUNCTION nxureadchar (file_id, data_name, data, units) RESULT (status)
530 TYPE(nxhandle),
INTENT(inout) :: file_id
531 CHARACTER(len=*),
INTENT(in) :: data_name
532 CHARACTER(len=*),
INTENT(out) :: data
533 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: units
534 INTEGER :: status, dimensions(nx_maxrank)
536 status = nxuconfirmdata(file_id, data_name, nx_char, 1, dimensions)
537 IF (status /= nx_ok) return
538 IF (dimensions(1) > len(data))
THEN
543 IF (status == nx_ok .and. present(units))
THEN
544 status =
nxgetattr(file_id,
"units", units)
551 data_size) result(status)
553 TYPE(nxhandle),
INTENT(inout) :: file_id
554 CHARACTER(len=*),
INTENT(in) :: data_name
555 INTEGER(kind=NXi4),
POINTER :: data(:)
556 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: units
557 INTEGER,
INTENT(in),
OPTIONAL :: data_start(:), data_size(:)
558 INTEGER :: status, dimensions(nx_maxrank)
560 status = nxuconfirmdata(file_id, data_name, nx_int32, 1, dimensions)
561 IF (status /= nx_ok) return
562 IF (present(data_start) .AND. present(data_size))
THEN
563 ALLOCATE (
data(data_size(1)))
564 status =
nxgetslab(file_id,
data, data_start, data_size)
566 ALLOCATE (
data(dimensions(1)))
569 IF (status == nx_ok .and. present(units))
THEN
570 status =
nxgetattr(file_id,
"units", units)
577 data_size) result(status)
579 TYPE(nxhandle),
INTENT(inout) :: file_id
580 CHARACTER(len=*),
INTENT(in) :: data_name
581 REAL(kind=NXr4),
POINTER :: data(:)
582 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: units
583 INTEGER,
INTENT(in),
OPTIONAL :: data_start(:), data_size(:)
584 INTEGER :: status, dimensions(nx_maxrank)
586 status = nxuconfirmdata(file_id, data_name, nx_float32, 1, dimensions)
587 IF (status /= nx_ok) return
588 IF (present(data_start) .AND. present(data_size))
THEN
589 ALLOCATE (
data(data_size(1)))
590 status =
nxgetslab(file_id,
data, data_start, data_size)
592 ALLOCATE (
data(dimensions(1)))
595 IF (status == nx_ok .and. present(units))
THEN
596 status =
nxgetattr(file_id,
"units", units)
603 data_size) result(status)
605 TYPE(nxhandle),
INTENT(inout) :: file_id
606 CHARACTER(len=*),
INTENT(in) :: data_name
607 REAL(kind=NXr8),
POINTER :: data(:)
608 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: units
609 INTEGER,
INTENT(in),
OPTIONAL :: data_start(:), data_size(:)
610 INTEGER :: status, dimensions(nx_maxrank)
612 status = nxuconfirmdata(file_id, data_name, nx_float64, 1, dimensions)
613 IF (status /= nx_ok) return
614 IF (present(data_start) .AND. present(data_size))
THEN
615 ALLOCATE (
data(data_size(1)))
616 status =
nxgetslab(file_id,
data, data_start, data_size)
618 ALLOCATE (
data(dimensions(1)))
621 IF (status == nx_ok .and. present(units))
THEN
622 status =
nxgetattr(file_id,
"units", units)
629 data_size) result(status)
631 TYPE(nxhandle),
INTENT(inout) :: file_id
632 CHARACTER(len=*),
INTENT(in) :: data_name
633 INTEGER(kind=NXi4),
POINTER :: data(:,:)
634 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: units
635 INTEGER,
INTENT(in),
OPTIONAL :: data_start(:), data_size(:)
636 INTEGER :: status, dimensions(nx_maxrank), data_shape(2)
637 INTEGER,
ALLOCATABLE :: buffer(:)
639 status = nxuconfirmdata(file_id, data_name, nx_int32, 2, dimensions)
640 IF (status /= nx_ok) return
641 IF (present(data_start) .AND. present(data_size))
THEN
642 ALLOCATE (buffer(product(data_size(1:2))))
643 status =
nxgetslab(file_id, buffer, data_start, data_size)
644 IF (status == nx_ok)
THEN
645 ALLOCATE (
data(data_size(1),data_size(2)))
646 data_shape = data_size(1:2)
647 data = reshape(buffer, data_shape)
650 ALLOCATE (buffer(product(dimensions(1:2))))
652 IF (status == nx_ok)
THEN
653 ALLOCATE (
data(dimensions(1),dimensions(2)))
654 data = reshape(buffer, dimensions(1:2))
657 IF (status == nx_ok .and. present(units))
THEN
658 status =
nxgetattr(file_id,
"units", units)
666 data_size) result(status)
668 TYPE(nxhandle),
INTENT(inout) :: file_id
669 CHARACTER(len=*),
INTENT(in) :: data_name
670 REAL(kind=NXr4),
POINTER :: data(:,:)
671 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: units
672 INTEGER,
INTENT(in),
OPTIONAL ::data_start(:), data_size(:)
673 INTEGER :: status, dimensions(nx_maxrank), data_shape(2)
674 REAL,
ALLOCATABLE :: buffer(:)
676 status = nxuconfirmdata(file_id, data_name, nx_float32, 2, dimensions)
677 IF (status /= nx_ok) return
678 IF (present(data_start) .AND. present(data_size))
THEN
679 ALLOCATE (buffer(product(data_size(1:2))))
680 status =
nxgetslab(file_id, buffer, data_start, data_size)
681 IF (status == nx_ok)
THEN
682 ALLOCATE (
data(data_size(1),data_size(2)))
683 data_shape = data_size(1:2)
684 data = reshape(buffer, data_shape)
687 ALLOCATE (buffer(product(dimensions(1:2))))
689 IF (status == nx_ok)
THEN
690 ALLOCATE (
data(dimensions(1),dimensions(2)))
691 data = reshape(buffer, dimensions(1:2))
694 IF (status == nx_ok .and. present(units))
THEN
695 status =
nxgetattr(file_id,
"units", units)
703 data_size) result(status)
705 TYPE(nxhandle),
INTENT(inout) :: file_id
706 CHARACTER(len=*),
INTENT(in) :: data_name
707 REAL(kind=NXr8),
POINTER :: data(:,:)
708 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: units
709 INTEGER,
INTENT(in),
OPTIONAL ::data_start(:), data_size(:)
710 INTEGER :: status, dimensions(nx_maxrank), data_shape(2)
711 REAL,
ALLOCATABLE :: buffer(:)
713 status = nxuconfirmdata(file_id, data_name, nx_float64, 2, dimensions)
714 IF (status /= nx_ok) return
715 IF (present(data_start) .AND. present(data_size))
THEN
716 ALLOCATE (buffer(product(data_size(1:2))))
717 status =
nxgetslab(file_id, buffer, data_start, data_size)
718 IF (status == nx_ok)
THEN
719 ALLOCATE (
data(data_size(1),data_size(2)))
720 data_shape = data_size(1:2)
721 data = reshape(buffer, data_shape)
724 ALLOCATE (buffer(product(dimensions(1:2))))
726 IF (status == nx_ok)
THEN
727 ALLOCATE (
data(dimensions(1),dimensions(2)))
728 data = reshape(buffer, dimensions(1:2))
731 IF (status == nx_ok .and. present(units))
THEN
732 status =
nxgetattr(file_id,
"units", units)
740 data_size) result(status)
742 TYPE(nxhandle),
INTENT(inout) :: file_id
743 CHARACTER(len=*),
INTENT(in) :: data_name
744 INTEGER(kind=NXi4),
POINTER :: data(:,:,:)
745 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: units
746 INTEGER,
INTENT(in),
OPTIONAL :: data_start(:), data_size(:)
747 INTEGER :: status, dimensions(nx_maxrank), data_shape(3)
748 INTEGER,
ALLOCATABLE :: buffer(:)
750 status = nxuconfirmdata(file_id, data_name, nx_int32, 3, dimensions)
751 IF (status /= nx_ok) return
752 IF (present(data_start) .AND. present(data_size))
THEN
753 ALLOCATE (buffer(product(data_size(1:3))))
754 status =
nxgetslab(file_id, buffer, data_start, data_size)
755 IF (status == nx_ok)
THEN
756 ALLOCATE (
data(data_size(1),data_size(2),data_size(3)))
757 data_shape = data_size(1:3)
758 data = reshape(buffer, data_shape)
761 ALLOCATE (buffer(product(dimensions(1:3))))
763 IF (status == nx_ok)
THEN
764 ALLOCATE (
data(dimensions(1),dimensions(2),dimensions(3)))
765 data = reshape(buffer, dimensions(1:3))
768 IF (status == nx_ok .and. present(units))
THEN
769 status =
nxgetattr(file_id,
"units", units)
777 data_size) result(status)
779 TYPE(nxhandle),
INTENT(inout) :: file_id
780 CHARACTER(len=*),
INTENT(in) :: data_name
781 REAL(kind=NXr4),
POINTER :: data(:,:,:)
782 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: units
783 INTEGER,
INTENT(in),
OPTIONAL :: data_start(:), data_size(:)
784 INTEGER :: status, dimensions(nx_maxrank), data_shape(3)
785 REAL,
ALLOCATABLE :: buffer(:)
787 status = nxuconfirmdata(file_id, data_name, nx_float32, 3, dimensions)
788 IF (status /= nx_ok) return
789 IF (present(data_start) .AND. present(data_size))
THEN
790 ALLOCATE (buffer(product(data_size(1:3))))
791 status =
nxgetslab(file_id, buffer, data_start, data_size)
792 IF (status == nx_ok)
THEN
793 ALLOCATE (
data(data_size(1),data_size(2),data_size(3)))
794 data_shape = data_size(1:3)
795 data = reshape(buffer, data_shape)
798 ALLOCATE (buffer(product(dimensions(1:3))))
800 IF (status == nx_ok)
THEN
801 ALLOCATE (
data(dimensions(1),dimensions(2),dimensions(3)))
802 data = reshape(buffer, dimensions(1:3))
805 IF (status == nx_ok .and. present(units))
THEN
806 status =
nxgetattr(file_id,
"units", units)
814 data_size) result(status)
816 TYPE(nxhandle),
INTENT(inout) :: file_id
817 CHARACTER(len=*),
INTENT(in) :: data_name
818 REAL(kind=NXr8),
POINTER :: data(:,:,:)
819 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: units
820 INTEGER,
INTENT(in),
OPTIONAL :: data_start(:), data_size(:)
821 INTEGER :: status, dimensions(nx_maxrank), data_shape(3)
822 REAL,
ALLOCATABLE :: buffer(:)
824 status = nxuconfirmdata(file_id, data_name, nx_float64, 3, dimensions)
825 IF (status /= nx_ok) return
826 IF (present(data_start) .AND. present(data_size))
THEN
827 ALLOCATE (buffer(product(data_size(1:3))))
828 status =
nxgetslab(file_id, buffer, data_start, data_size)
829 IF (status == nx_ok)
THEN
830 ALLOCATE (
data(data_size(1),data_size(2),data_size(3)))
831 data_shape = data_size(1:3)
832 data = reshape(buffer, data_shape)
835 ALLOCATE (buffer(product(dimensions(1:3))))
837 IF (status == nx_ok)
THEN
838 ALLOCATE (
data(dimensions(1),dimensions(2),dimensions(3)))
839 data = reshape(buffer, dimensions(1:3))
842 IF (status == nx_ok .and. present(units))
THEN
843 status =
nxgetattr(file_id,
"units", units)
854 TYPE(nxhandle),
INTENT(inout) :: file_id
855 INTEGER,
INTENT(in) :: compress_type
856 INTEGER,
INTENT(in),
OPTIONAL :: compress_size
859 IF (compress_type == nx_comp_lzw .OR. compress_type == nx_comp_huf .OR. &
860 compress_type == nx_comp_rle .OR. compress_type == nx_comp_none)
THEN
861 nxcompress_type = compress_type
862 IF (present(compress_size)) nxcompress_size = compress_size
865 call
nxerror(
"Invalid compression option")
872 FUNCTION nxufindgroup (file_id, group_name, group_class) RESULT (status)
874 TYPE(nxhandle),
INTENT(inout) :: file_id
875 CHARACTER(len=*),
INTENT(in) :: group_name
876 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: group_class
877 CHARACTER(len=NX_MAXNAMELEN),
ALLOCATABLE :: name(:), class(:)
878 INTEGER :: status, n, i
881 IF (status /= nx_ok) return
882 ALLOCATE (name(n), class(n), stat=status)
883 IF (status /= 0)
THEN
884 call
nxerror(
"Unable to allocate directory arrays")
889 IF (status == nx_ok)
THEN
892 IF (trim(name(i)) == trim(group_name))
THEN
893 group_class = trim(class(i))
894 IF (class(i)(1:2) ==
"NX")
THEN
897 CALL
nxerror(trim(name(i))//
" is not a group")
904 DEALLOCATE (name, class)
912 TYPE(nxhandle),
INTENT(inout) :: file_id
913 CHARACTER(len=*),
INTENT(in) :: group_class
914 CHARACTER(len=*),
INTENT(out) :: group_name
915 INTEGER,
INTENT(in),
OPTIONAL :: find_index
916 CHARACTER(len=NX_MAXNAMELEN),
ALLOCATABLE :: name(:), class(:)
917 INTEGER :: status, n, i, j
920 IF (status /= nx_ok) return
921 ALLOCATE (name(n), class(n), stat=status)
922 IF (status /= 0)
THEN
923 CALL
nxerror(
"Unable to allocate directory arrays")
928 IF (status == nx_ok)
THEN
932 IF (trim(class(i)) == trim(group_class))
THEN
933 IF (present(find_index))
THEN
935 IF (j < find_index) cycle
937 group_name = trim(name(i))
943 DEALLOCATE (name, class)
950 TYPE(nxhandle),
INTENT(inout) :: file_id
951 CHARACTER(len=*),
INTENT(in) :: data_name
952 CHARACTER(len=NX_MAXNAMELEN),
ALLOCATABLE :: name(:), class(:)
953 INTEGER :: status, n, i
956 IF (status /= nx_ok) return
957 ALLOCATE (name(n), class(n), stat=status)
958 IF (status /= 0)
THEN
959 call
nxerror(
"Unable to allocate directory arrays")
964 IF (status == nx_ok)
THEN
967 IF (trim(name(i)) == trim(data_name))
THEN
968 IF (class(i)(1:3) ==
"SDS")
THEN
971 CALL
nxerror(trim(name(i))//
" is not a data item")
978 DEALLOCATE (name, class)
985 TYPE(nxhandle),
INTENT(inout) :: file_id
986 CHARACTER(len=*),
INTENT(in) :: attr_name
987 CHARACTER(len=NX_MAXNAMELEN),
ALLOCATABLE :: name(:)
988 INTEGER :: status, n, i
991 IF (status /= nx_ok) return
992 ALLOCATE (name(n), stat=status)
993 IF (status /= 0)
THEN
994 call
nxerror(
"Unable to allocate directory arrays")
999 IF (status == nx_ok)
THEN
1002 IF (trim(name(i)) == trim(attr_name)) status = nx_ok
1011 data_dimensions) result(status)
1013 TYPE(nxhandle),
INTENT(inout) :: file_id
1014 INTEGER,
INTENT(in) :: signal
1015 CHARACTER(len=*) :: data_name
1016 INTEGER,
INTENT(out) :: data_rank, data_type, data_dimensions(:)
1017 CHARACTER(len=len(data_name)) :: name
1018 CHARACTER(len=NX_MAXNAMELEN) :: class, attr_name
1019 INTEGER :: status, value
1022 IF (status /= nx_ok) return
1025 IF (status == nx_ok .AND. class ==
"SDS")
THEN
1027 IF (status /= nx_ok) return
1029 IF (status == nx_ok)
THEN
1030 status =
nxgetattr(file_id,
"signal", value)
1031 IF (status /= nx_ok) return
1032 IF (value == signal)
THEN
1033 status =
nxgetinfo(file_id, nxrank, nxdims, nxtype)
1034 IF (status == nx_ok)
THEN
1038 data_dimensions = nxdims
1042 ELSE IF (status == nx_eod)
THEN
1044 ELSE IF (status == nx_error)
THEN
1047 ELSE IF (status == nx_eod)
THEN
1048 CALL
nxerror(
"No data with the attribute ""signal"" found")
1051 ELSE IF (status == nx_error)
THEN
1060 data_dimensions) result(status)
1062 TYPE(nxhandle),
INTENT(inout) :: file_id
1063 INTEGER,
INTENT(in) :: axis, primary
1064 CHARACTER(len=*) :: data_name
1065 INTEGER,
INTENT(out) :: data_type, data_dimensions(nx_maxrank)
1066 CHARACTER(len=len(data_name)) :: name
1067 CHARACTER(len=NX_MAXNAMELEN) :: class, attr_name
1068 CHARACTER(len=255) :: axis_list
1069 INTEGER :: status, signal=1, value, data_rank, c_axis, i, j, k
1072 status =
nxufindsignal(file_id, signal, data_name, data_rank, &
1073 data_type, data_dimensions)
1074 IF (status /= nx_ok) return
1076 IF (axis > data_rank)
THEN
1077 CALL
nxerror(
"Axis number greater than the data rank")
1083 IF (status /= nx_ok) return
1085 IF (status == nx_error)
THEN
1087 ELSE IF (status == nx_ok)
THEN
1088 status =
nxgetattr(file_id,
"axes", axis_list)
1090 IF (index(axis_list,
"[") > 0)
THEN
1091 axis_list = axis_list(index(axis_list,
"[")+1:len(axis_list))
1093 IF (index(axis_list,
"]") > 0)
THEN
1094 axis_list = axis_list(1:index(axis_list,
"]")-1)
1097 c_axis = data_rank - axis + 1
1101 k = scan(axis_list(j:),
",:") - 1
1102 IF (k < 0) k = len(trim(axis_list)) - j + 1
1104 CALL
nxerror(
"Data attribute ""axes"" is not correctly defined")
1108 name = adjustl(axis_list(j:j+k-1))
1113 IF (status /= nx_ok) return
1114 status =
nxgetinfo(file_id, nxrank, nxdims, nxtype)
1115 IF (status == nx_ok)
THEN
1118 data_dimensions = nxdims(1)
1126 IF (status /= nx_ok) return
1129 IF (status == nx_ok .AND. class ==
"SDS")
THEN
1131 IF (status /= nx_ok) return
1133 IF (status == nx_ok)
THEN
1134 status =
nxgetattr(file_id,
"axis", value)
1135 IF (status /= nx_ok) return
1136 IF (value == axis)
THEN
1138 IF (status == nx_ok)
THEN
1139 status =
nxgetattr(file_id,
"primary", value)
1140 ELSE IF (status == nx_eod)
THEN
1145 IF (value == primary)
THEN
1146 status =
nxgetinfo(file_id, nxrank, nxdims, nxtype)
1147 IF (status == nx_ok)
THEN
1150 data_dimensions = nxdims(1)
1158 ELSE IF (status == nx_eod)
THEN
1159 CALL
nxerror(
"Requested axis not found")
1162 ELSE IF (status == nx_error)
THEN
1172 TYPE(nxhandle),
INTENT(inout) :: file_id
1173 TYPE(nxlink),
INTENT(out) :: group_id
1174 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: group_class
1180 IF (status /= nx_ok) return
1182 IF (status /= nx_ok) return
1185 IF (status /= nx_ok) return
1188 status = nxusearchgroup(file_id, group_id, data_id, group_class)
1195 TYPE(nxhandle),
INTENT(inout) :: file_id
1196 TYPE(nxlink),
INTENT(in) :: group_id
1198 CHARACTER(len=NX_MAXNAMELEN),
ALLOCATABLE :: name(:), class(:)
1199 INTEGER :: status, n, i
1202 DO i = 1, group_level
1204 IF (status /= nx_ok) return
1208 IF (status /= nx_ok) return
1209 ALLOCATE (name(n), class(n), stat=status)
1210 IF (status /= 0)
THEN
1211 CALL
nxerror(
"Unable to allocate space for group info")
1216 IF (status == nx_ok)
THEN
1218 IF (class(i)(1:2) ==
"NX")
THEN
1220 IF (status /= nx_ok) exit
1222 IF (status /= nx_ok) exit
1223 IF (
nxsameid(file_id, new_id, group_id)) exit
1225 IF (status /= nx_ok) exit
1231 DEALLOCATE (name, class)
1236 RECURSIVE FUNCTION nxusearchgroup (file_id, group_id, data_id, &
1237 group_class) result(status)
1239 TYPE(nxhandle),
INTENT(inout) :: file_id
1240 TYPE(nxlink),
INTENT(in) :: group_id, data_id
1241 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: group_class
1243 CHARACTER(len=NX_MAXNAMELEN),
ALLOCATABLE :: name(:), class(:)
1244 CHARACTER(len=NX_MAXNAMELEN) :: current_group, current_class
1245 INTEGER :: status, n, i
1248 status =
nxgetgroupinfo(file_id, n, current_group, current_class)
1249 IF (status /= nx_ok) return
1250 ALLOCATE (name(n), class(n), stat=status)
1251 IF (status /= 0)
THEN
1252 CALL
nxerror(
"Unable to allocate space for group info")
1257 IF (status == nx_ok)
THEN
1259 IF (class(i)(1:3) ==
"SDS")
THEN
1260 IF (present(group_class) .AND. &
1261 trim(group_class) /= trim(current_class))
THEN
1266 IF (status /= nx_ok) exit
1268 IF (status /= nx_ok) exit
1269 IF (
nxsameid(file_id, new_id, data_id))
THEN
1273 ELSE IF (class(i)(1:2) ==
"NX")
THEN
1275 IF (status /= nx_ok) exit
1277 IF (status /= nx_ok) exit
1279 IF (
nxsameid(file_id, new_id, group_id))
THEN
1281 IF (status /= nx_ok) exit
1284 group_level = group_level + 1
1285 status = nxusearchgroup(file_id, group_id, data_id, group_class)
1286 IF (status == nx_ok) exit
1288 group_level = group_level - 1
1289 IF (status /= nx_ok) exit
1295 DEALLOCATE (name, class)
1297 END FUNCTION nxusearchgroup
1300 FUNCTION nxupreparedata (file_id, data_name, data_type, data_rank, &
1301 data_dimensions) result(status)
1303 TYPE(nxhandle),
INTENT(inout) :: file_id
1304 CHARACTER(len=*),
INTENT(in) :: data_name
1305 INTEGER,
INTENT(in) :: data_type, data_rank
1306 INTEGER,
INTENT(in) :: data_dimensions(:)
1307 INTEGER :: status, i
1310 IF (status == nx_eod)
THEN
1311 IF (nxcompress_type /= nx_comp_none .AND. &
1312 product(data_dimensions(1:data_rank)) > nxcompress_size)
THEN
1313 status =
nxmakedata(file_id, data_name, data_type, data_rank, &
1314 data_dimensions, nxcompress_type)
1316 status =
nxmakedata(file_id, data_name, data_type, data_rank, &
1319 IF (status == nx_ok) status =
nxopendata(file_id, data_name)
1320 ELSE if (status == nx_ok)
THEN
1322 IF (status /= nx_ok) return
1323 status =
nxgetinfo(file_id, nxrank, nxdims, nxtype)
1324 IF (nxtype /= data_type)
THEN
1325 CALL
nxerror(
"Type of existing data item does not match new data")
1327 ELSE IF (nxrank /= data_rank)
THEN
1328 CALL
nxerror(
"Rank of existing data item does not match new data")
1332 IF (data_dimensions(i) > nxdims(i))
THEN
1333 call
nxerror(
"Size of new data too large for existing item")
1341 END FUNCTION nxupreparedata
1344 FUNCTION nxuconfirmdata (file_id, data_name, data_type, data_rank, &
1345 data_dimensions) result(status)
1347 TYPE(nxhandle),
INTENT(inout) :: file_id
1348 CHARACTER(len=*),
INTENT(in) :: data_name
1349 INTEGER,
INTENT(in) :: data_type, data_rank
1350 INTEGER,
INTENT(out) :: data_dimensions(:)
1354 IF (status /= nx_ok) return
1355 status =
nxgetinfo(file_id, nxrank, nxdims, nxtype)
1356 IF (status /= nx_ok) return
1357 IF (nxrank == data_rank)
THEN
1359 IF (nxtype /= data_type .AND. (nxtype/10) /= (data_type/10))
THEN
1360 CALL
nxerror(
"Type of data does not match supplied array")
1362 data_dimensions(1:nxrank) = nxdims(1:nxrank)
1367 CALL
nxerror(
"Rank of data does not match supplied array")
1372 END FUNCTION nxuconfirmdata