FMS  2024.03
Flexible Modeling System
get_global_attribute.inc
1 !***********************************************************************
2 !* GNU Lesser General Public License
3 !*
4 !* This file is part of the GFDL Flexible Modeling System (FMS).
5 !*
6 !* FMS is free software: you can redistribute it and/or modify it under
7 !* the terms of the GNU Lesser General Public License as published by
8 !* the Free Software Foundation, either version 3 of the License, or (at
9 !* your option) any later version.
10 !*
11 !* FMS is distributed in the hope that it will be useful, but WITHOUT
12 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 !* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 !* for more details.
15 !*
16 !* You should have received a copy of the GNU Lesser General Public
17 !* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18 !***********************************************************************
19 !> @file
20 !> @brief Routines for retrieving global attribute values from netcdf files with different
21 !! dimension sizes for the @ref get_global_attribute interface
22 
23 !> @addtogroup netcdf_io_mod
24 !> @{
25 
26 !> @brief Get the value of a global attribute.
27 subroutine get_global_attribute_0d(fileobj, &
28  attribute_name, &
29  attribute_value, &
30  broadcast)
31  class(fmsnetcdffile_t),intent(in) :: fileobj !< File object.
32  character(len=*),intent(in) :: attribute_name !< Attribute name.
33  class(*), intent(inout) :: attribute_value !< Attribute value
34  logical,intent(in),optional :: broadcast !< Flag controlling whether or
35  !! not the data will be
36  !! broadcasted to non
37  !! "I/O root" ranks.
38  !! The broadcast will be done
39  !! by default.
40  integer :: err
41  character(len=1024), dimension(1) :: charbuf !< 1D Character buffer
42 
43  if (fileobj%is_root) then
44  select type(attribute_value)
45  type is (character(len=*))
46  err = nf90_get_att(fileobj%ncid, &
47  nf90_global, &
48  trim(attribute_name), &
49  charbuf(1))
50  call string_copy(attribute_value, charbuf(1), check_for_null=.true.)
51  type is (integer(kind=i4_kind))
52  err = nf90_get_att(fileobj%ncid, &
53  nf90_global, &
54  trim(attribute_name), &
55  attribute_value)
56  type is (integer(kind=i8_kind))
57  if ( .not. fileobj%is_netcdf4) call error(trim(fileobj%path)// &
58  & ": 64 bit integers are only supported with 'netcdf4' file format"//&
59  & ". Set netcdf_default_format='netcdf4' in the fms2_io namelist OR "//&
60  & "add nc_format='netcdf4' to your open_file call")
61  err = nf90_get_att(fileobj%ncid, &
62  nf90_global, &
63  trim(attribute_name), &
64  attribute_value)
65  type is (real(kind=r4_kind))
66  err = nf90_get_att(fileobj%ncid, &
67  nf90_global, &
68  trim(attribute_name), &
69  attribute_value)
70  type is (real(kind=r8_kind))
71  err = nf90_get_att(fileobj%ncid, &
72  nf90_global, &
73  trim(attribute_name), &
74  attribute_value)
75  class default
76  call error("get_global_attribute_0d: unsupported type for "//&
77  &trim(attribute_name)//" for file: "//trim(fileobj%path)//"")
78  end select
79  call check_netcdf_code(err, "get_global_attribute_0d: file:"//trim(fileobj%path)//"- attribute:"// &
80  & trim(attribute_name))
81  endif
82  if (present(broadcast)) then
83  if (.not. broadcast) then
84  return
85  endif
86  endif
87  select type(attribute_value)
88  type is (character(len=*))
89  call mpp_broadcast(charbuf, len(charbuf), &
90  fileobj%io_root, &
91  pelist=fileobj%pelist)
92  call string_copy(attribute_value, charbuf(1), check_for_null=.true.)
93  type is (integer(kind=i4_kind))
94  call mpp_broadcast(attribute_value, &
95 
96  fileobj%io_root, &
97  pelist=fileobj%pelist)
98  type is (integer(kind=i8_kind))
99  call mpp_broadcast(attribute_value, &
100 
101  fileobj%io_root, &
102  pelist=fileobj%pelist)
103  type is (real(kind=r4_kind))
104  call mpp_broadcast(attribute_value, &
105 
106  fileobj%io_root, &
107  pelist=fileobj%pelist)
108  type is (real(kind=r8_kind))
109  call mpp_broadcast(attribute_value, &
110 
111  fileobj%io_root, &
112  pelist=fileobj%pelist)
113  class default
114  call error("get_global_attribute_0d: unsupported type for "//&
115  &trim(attribute_name)//" for file: "//trim(fileobj%path)//"")
116  end select
117 end subroutine get_global_attribute_0d
118 !> @brief Get the value of a global attribute.
119 subroutine get_global_attribute_1d(fileobj, &
120  attribute_name, &
121  attribute_value, &
122  broadcast)
123  class(fmsnetcdffile_t),intent(in) :: fileobj !< File object.
124  character(len=*),intent(in) :: attribute_name !< Attribute name.
125  class(*),dimension(:), intent(inout) :: attribute_value !< Attribute value
126  logical,intent(in),optional :: broadcast !< Flag controlling whether or
127  !! not the data will be
128  !! broadcasted to non
129  !! "I/O root" ranks.
130  !! The broadcast will be done
131  !! by default.
132  integer :: err
133  if (fileobj%is_root) then
134  select type(attribute_value)
135  type is (integer(kind=i4_kind))
136  err = nf90_get_att(fileobj%ncid, &
137  nf90_global, &
138  trim(attribute_name), &
139  attribute_value)
140  type is (integer(kind=i8_kind))
141  if ( .not. fileobj%is_netcdf4) call error(trim(fileobj%path)// &
142  & ": 64 bit integers are only supported with 'netcdf4' file format"//&
143  & ". Set netcdf_default_format='netcdf4' in the fms2_io namelist OR "//&
144  & "add nc_format='netcdf4' to your open_file call")
145  err = nf90_get_att(fileobj%ncid, &
146  nf90_global, &
147  trim(attribute_name), &
148  attribute_value)
149  type is (real(kind=r4_kind))
150  err = nf90_get_att(fileobj%ncid, &
151  nf90_global, &
152  trim(attribute_name), &
153  attribute_value)
154  type is (real(kind=r8_kind))
155  err = nf90_get_att(fileobj%ncid, &
156  nf90_global, &
157  trim(attribute_name), &
158  attribute_value)
159  class default
160  call error("get_global_attribute_1d: unsupported type for "//&
161  &trim(attribute_name)//" for file: "//trim(fileobj%path)//"")
162  end select
163  call check_netcdf_code(err, "get_global_attribute_1d: file:"//trim(fileobj%path)//"- attribute:"// &
164  & trim(attribute_name))
165  endif
166  if (present(broadcast)) then
167  if (.not. broadcast) then
168  return
169  endif
170  endif
171  select type(attribute_value)
172  type is (integer(kind=i4_kind))
173  call mpp_broadcast(attribute_value, &
174  size(attribute_value), &
175  fileobj%io_root, &
176  pelist=fileobj%pelist)
177  type is (integer(kind=i8_kind))
178  call mpp_broadcast(attribute_value, &
179  size(attribute_value), &
180  fileobj%io_root, &
181  pelist=fileobj%pelist)
182  type is (real(kind=r4_kind))
183  call mpp_broadcast(attribute_value, &
184  size(attribute_value), &
185  fileobj%io_root, &
186  pelist=fileobj%pelist)
187  type is (real(kind=r8_kind))
188  call mpp_broadcast(attribute_value, &
189  size(attribute_value), &
190  fileobj%io_root, &
191  pelist=fileobj%pelist)
192  class default
193  call error("get_global_attribute_1d: unsupported type for "//&
194  &trim(attribute_name)//" for file: "//trim(fileobj%path)//"")
195  end select
196 end subroutine get_global_attribute_1d
197 !> @}
get_global_attribute_1d
subroutine get_global_attribute_1d(fileobj, attribute_name, attribute_value, broadcast)
Get the value of a global attribute.
Definition: get_global_attribute.inc:123
get_global_attribute_0d
subroutine get_global_attribute_0d(fileobj, attribute_name, attribute_value, broadcast)
Get the value of a global attribute.
Definition: get_global_attribute.inc:31