source: LMDZ5/tags/proto-testing-20131015/tools/Max_diff_nc_with_lib/NetCDF95/nf95_get_att.f90 @ 2300

Last change on this file since 2300 was 1795, checked in by Ehouarn Millour, 11 years ago

Version testing basee sur la r1794


Testing release based on r1794

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