source: LMDZ6/trunk/libf/misc/nf95_get_att_m.F90 @ 3741

Last change on this file since 3741 was 1907, checked in by lguez, 11 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 
1! $Id$
2module 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
20contains
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
105end module nf95_get_att_m
Note: See TracBrowser for help on using the repository browser.