Line |
Branch |
Exec |
Source |
1 |
|
|
! $Id$ |
2 |
|
|
module nf95_get_att_m |
3 |
|
|
|
4 |
|
|
use handle_err_m, only: handle_err |
5 |
|
|
use netcdf, only: nf90_get_att, nf90_noerr |
6 |
|
|
use simple, only: nf95_inquire_attribute |
7 |
|
|
|
8 |
|
|
implicit none |
9 |
|
|
|
10 |
|
|
interface nf95_get_att |
11 |
|
|
module procedure nf95_get_att_text, nf95_get_att_one_FourByteInt |
12 |
|
|
|
13 |
|
|
! The difference between the specific procedures is the type of |
14 |
|
|
! argument "values". |
15 |
|
|
end interface |
16 |
|
|
|
17 |
|
|
private |
18 |
|
|
public nf95_get_att |
19 |
|
|
|
20 |
|
|
contains |
21 |
|
|
|
22 |
|
✗ |
subroutine nf95_get_att_text(ncid, varid, name, values, ncerr) |
23 |
|
|
|
24 |
|
|
integer, intent( in) :: ncid, varid |
25 |
|
|
character(len = *), intent( in) :: name |
26 |
|
|
character(len = *), intent(out) :: values |
27 |
|
|
integer, intent(out), optional:: ncerr |
28 |
|
|
|
29 |
|
|
! Variables local to the procedure: |
30 |
|
|
integer ncerr_not_opt |
31 |
|
|
integer att_len |
32 |
|
|
|
33 |
|
|
!------------------- |
34 |
|
|
|
35 |
|
|
! Check that the length of "values" is large enough: |
36 |
|
|
call nf95_inquire_attribute(ncid, varid, name, nclen=att_len, & |
37 |
|
✗ |
ncerr=ncerr_not_opt) |
38 |
|
✗ |
if (ncerr_not_opt == nf90_noerr) then |
39 |
|
✗ |
if (len(values) < att_len) then |
40 |
|
✗ |
print *, "nf95_get_att_text" |
41 |
|
✗ |
print *, "varid = ", varid |
42 |
|
✗ |
print *, "attribute name: ", name |
43 |
|
✗ |
print *, 'length of "values" is not large enough' |
44 |
|
✗ |
print *, "len(values) = ", len(values) |
45 |
|
✗ |
print *, "number of characters in attribute: ", att_len |
46 |
|
✗ |
stop 1 |
47 |
|
|
end if |
48 |
|
|
end if |
49 |
|
|
|
50 |
|
✗ |
values = "" ! useless in NetCDF version 3.6.2 or better |
51 |
|
✗ |
ncerr_not_opt = nf90_get_att(ncid, varid, name, values) |
52 |
|
✗ |
if (present(ncerr)) then |
53 |
|
✗ |
ncerr = ncerr_not_opt |
54 |
|
|
else |
55 |
|
|
call handle_err("nf95_get_att_text " // trim(name), ncerr_not_opt, & |
56 |
|
✗ |
ncid, varid) |
57 |
|
|
end if |
58 |
|
|
|
59 |
|
✗ |
if (att_len >= 1 .and. ncerr_not_opt == nf90_noerr) then |
60 |
|
|
! Remove null terminator, if any: |
61 |
|
✗ |
if (iachar(values(att_len:att_len)) == 0) values(att_len:att_len) = " " |
62 |
|
|
end if |
63 |
|
|
|
64 |
|
✗ |
end subroutine nf95_get_att_text |
65 |
|
|
|
66 |
|
|
!*********************** |
67 |
|
|
|
68 |
|
✗ |
subroutine nf95_get_att_one_FourByteInt(ncid, varid, name, values, ncerr) |
69 |
|
|
|
70 |
|
|
integer, intent( in) :: ncid, varid |
71 |
|
|
character(len = *), intent( in) :: name |
72 |
|
|
integer , intent(out) :: values |
73 |
|
|
integer, intent(out), optional:: ncerr |
74 |
|
|
|
75 |
|
|
! Variables local to the procedure: |
76 |
|
|
integer ncerr_not_opt |
77 |
|
|
integer att_len |
78 |
|
|
|
79 |
|
|
!------------------- |
80 |
|
|
|
81 |
|
|
! Check that the attribute contains a single value: |
82 |
|
|
call nf95_inquire_attribute(ncid, varid, name, nclen=att_len, & |
83 |
|
✗ |
ncerr=ncerr_not_opt) |
84 |
|
✗ |
if (ncerr_not_opt == nf90_noerr) then |
85 |
|
✗ |
if (att_len /= 1) then |
86 |
|
✗ |
print *, "nf95_get_att_one_FourByteInt" |
87 |
|
✗ |
print *, "varid = ", varid |
88 |
|
✗ |
print *, "attribute name: ", name |
89 |
|
✗ |
print *, 'the attribute does not contain a single value' |
90 |
|
✗ |
print *, "number of values in attribute: ", att_len |
91 |
|
✗ |
stop 1 |
92 |
|
|
end if |
93 |
|
|
end if |
94 |
|
|
|
95 |
|
✗ |
ncerr_not_opt = nf90_get_att(ncid, varid, name, values) |
96 |
|
✗ |
if (present(ncerr)) then |
97 |
|
✗ |
ncerr = ncerr_not_opt |
98 |
|
|
else |
99 |
|
|
call handle_err("nf95_get_att_one_FourByteInt " // trim(name), & |
100 |
|
✗ |
ncerr_not_opt, ncid, varid) |
101 |
|
|
end if |
102 |
|
|
|
103 |
|
✗ |
end subroutine nf95_get_att_one_FourByteInt |
104 |
|
|
|
105 |
|
|
end module nf95_get_att_m |
106 |
|
|
|