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