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