FMS 2025.01.02-dev
Flexible Modeling System
Loading...
Searching...
No Matches
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.
27subroutine 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
117end subroutine get_global_attribute_0d
118!> @brief Get the value of a global attribute.
119subroutine 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
196end 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