source: LMDZ5/trunk/tools/Max_diff_nc_with_lib/NetCDF95/nf95_get_att.f90 @ 1907

Last change on this file since 1907 was 1907, checked in by lguez, 10 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
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.