FMS  2025.04
Flexible Modeling System
array_utils_char.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 Character array routines used in @ref fms_io_utils_mod
20 
21 !> @addtogroup fms_io_utils_mod
22 !> @{
23 
24 !> @brief Allocate character arrays using an input array of sizes.
25 subroutine allocate_array_char_1d(buf, sizes, initialize)
26 
27  character(len=*), dimension(:), allocatable, intent(inout) :: buf !< Array that will be allocated.
28  integer, dimension(1), intent(in) :: sizes !< Array of dimension sizes.
29  logical, intent(in), optional :: initialize !< Optional argument when true will initialize with a blank string.
30 
31  logical :: init !< local variable for initialize
32  integer :: i, c !< for looping
33 
34  init = .false.
35  if (present(initialize)) init = initialize
36 
37  if (allocated(buf)) then
38  deallocate(buf)
39  endif
40  allocate(buf(sizes(1)))
41 
42  if (init) then
43  do i = 1, sizes(1)
44  do c = 1, len(buf(i))
45  buf(i)(c:c) = " "
46  enddo
47  enddo
48  endif
49 
50 end subroutine allocate_array_char_1d
51 
52 
53 !> @brief Allocate character arrays using an input array of sizes.
54 subroutine allocate_array_char_2d(buf, sizes, initialize)
55 
56  character(len=*), dimension(:,:), allocatable, intent(inout) :: buf !< Array that will be allocated.
57  integer, dimension(2), intent(in) :: sizes !< Array of dimension sizes.
58  logical, intent(in), optional :: initialize !< Optional argument when true will initialize with a blank string.
59 
60  logical :: init !< local variable for initialize
61  integer :: i, j, c !< for looping
62 
63  init = .false.
64  if (present(initialize)) init = initialize
65 
66  if (allocated(buf)) then
67  deallocate(buf)
68  endif
69  allocate(buf(sizes(1), sizes(2)))
70 
71  if (init) then
72  do j = 1, sizes(2)
73  do i = 1, sizes(1)
74  do c = 1, len(buf(i,j))
75  buf(i,j)(c:c) = " "
76  enddo
77  enddo
78  enddo
79  endif
80 
81 end subroutine allocate_array_char_2d
82 
83 
84 !> @brief Allocate character arrays using an input array of sizes.
85 subroutine allocate_array_char_3d(buf, sizes, initialize)
86 
87  character(len=*), dimension(:,:,:), allocatable, intent(inout) :: buf !< Array that will be allocated.
88  integer, dimension(3), intent(in) :: sizes !< Array of dimension sizes.
89  logical, intent(in), optional :: initialize !< Optional argument when true will initialize with a blank string.
90 
91  logical :: init !< local variable for initialize
92  integer :: i, j, k, c !< for looping
93 
94  init = .false.
95  if (present(initialize)) init = initialize
96 
97  if (allocated(buf)) then
98  deallocate(buf)
99  endif
100  allocate(buf(sizes(1), sizes(2), sizes(3)))
101 
102  if (init) then
103  do k = 1, sizes(3)
104  do j = 1, sizes(2)
105  do i = 1, sizes(1)
106  do c = 1, len(buf(i,j,k))
107  buf(i,j,k)(c:c) = " "
108  enddo
109  enddo
110  enddo
111  enddo
112  endif
113 
114 end subroutine allocate_array_char_3d
115 
116 
117 !> @brief Allocate character arrays using an input array of sizes.
118 subroutine allocate_array_char_4d(buf, sizes, initialize)
119 
120  character(len=*), dimension(:,:,:,:), allocatable, intent(inout) :: buf !< Array that will be allocated.
121  integer, dimension(4), intent(in) :: sizes !< Array of dimension sizes.
122  logical, intent(in), optional :: initialize !< Optional argument when true will initialize with a blank string.
123 
124  logical :: init !< local variable for initialize
125  integer :: i, j, k, l, c !< for looping
126 
127  init = .false.
128  if (present(initialize)) init = initialize
129 
130  if (allocated(buf)) then
131  deallocate(buf)
132  endif
133  allocate(buf(sizes(1), sizes(2), sizes(3), sizes(4)))
134 
135  if (init) then
136  do l = 1, sizes(4)
137  do k = 1, sizes(3)
138  do j = 1, sizes(2)
139  do i = 1, sizes(1)
140  do c = 1, len(buf(i,j,k,l))
141  buf(i,j,k,l)(c:c) = " "
142  enddo
143  enddo
144  enddo
145  enddo
146  enddo
147  endif
148 end subroutine allocate_array_char_4d
149 
150 
151 !> @brief Allocate character arrays using an input array of sizes.
152 subroutine allocate_array_char_5d(buf, sizes, initialize)
153 
154  character(len=*), dimension(:,:,:,:,:), allocatable, intent(inout) :: buf !< Array that will be allocated.
155  integer, dimension(5), intent(in) :: sizes !< Array of dimension sizes.
156  logical, intent(in), optional :: initialize !< Optional argument when true will initialize with a blank string.
157 
158  logical :: init !< local variable for initialize
159  integer :: i, j, k, l, m, c !< for looping
160 
161  init = .false.
162  if (present(initialize)) init = initialize
163 
164  if (allocated(buf)) then
165  deallocate(buf)
166  endif
167  allocate(buf(sizes(1), sizes(2), sizes(3), sizes(4), sizes(5)))
168 
169  if (init) then
170  do m = 1, sizes(5)
171  do l = 1, sizes(4)
172  do k = 1, sizes(3)
173  do j = 1, sizes(2)
174  do i = 1, sizes(1)
175  do c = 1, len(buf(i,j,k,l,m))
176  buf(i,j,k,l,m)(c:c) = " "
177  enddo
178  enddo
179  enddo
180  enddo
181  enddo
182  enddo
183  endif
184 end subroutine allocate_array_char_5d
185 
186 
187 !> @brief Allocate character arrays using an input array of sizes.
188 subroutine allocate_array_char_6d(buf, sizes, initialize)
189 
190  character(len=*), dimension(:,:,:,:,:,:), allocatable, intent(inout) :: buf !< Array that will be allocated.
191  integer, dimension(6), intent(in) :: sizes !< Array of dimension sizes.
192  logical, intent(in), optional :: initialize !< Optional argument when true will initialize with a blank string.
193 
194  logical :: init !< local variable for initialize
195  integer :: i, j, k, l, m, n, c !< for looping
196 
197  init = .false.
198  if (present(initialize)) init = initialize
199 
200  if (allocated(buf)) then
201  deallocate(buf)
202  endif
203  allocate(buf(sizes(1), sizes(2), sizes(3), sizes(4), sizes(5), sizes(6)))
204 
205  if (init) then
206  do n = 1, sizes(6)
207  do m = 1, sizes(5)
208  do l = 1, sizes(4)
209  do k = 1, sizes(3)
210  do j = 1, sizes(2)
211  do i = 1, sizes(1)
212  do c = 1, len(buf(i,j,k,l,m,n))
213  buf(i,j,k,l,m,n)(c:c) = " "
214  enddo
215  enddo
216  enddo
217  enddo
218  enddo
219  enddo
220  enddo
221  endif
222 end subroutine allocate_array_char_6d
223 !> @}
subroutine allocate_array_char_5d(buf, sizes, initialize)
Allocate character arrays using an input array of sizes.
subroutine allocate_array_char_3d(buf, sizes, initialize)
Allocate character arrays using an input array of sizes.
subroutine allocate_array_char_4d(buf, sizes, initialize)
Allocate character arrays using an input array of sizes.
subroutine allocate_array_char_6d(buf, sizes, initialize)
Allocate character arrays using an input array of sizes.
subroutine allocate_array_char_1d(buf, sizes, initialize)
Allocate character arrays using an input array of sizes.
subroutine allocate_array_char_2d(buf, sizes, initialize)
Allocate character arrays using an input array of sizes.