OpenCMISS-Iron Internal API Documentation
util_array.f90
Go to the documentation of this file.
1 
41 
43 MODULE util_array
44  USE base_routines
45  USE types
46 
47 #include "macros.h"
48 
49  IMPLICIT NONE
50 
51  INTERFACE reallocate
52  MODULE PROCEDURE reallocate_int
53  MODULE PROCEDURE reallocate_real
54  MODULE PROCEDURE reallocate_string
55  END INTERFACE reallocate
56 
57  INTERFACE grow_array
58  MODULE PROCEDURE grow_array_int
59  MODULE PROCEDURE grow_array_real
60  END INTERFACE grow_array
61 
62  PUBLIC :: reallocate, grow_array
63 
64 CONTAINS
65 
66  !
67  !================================================================================================================================
68  !
69 
70  SUBROUTINE reallocate_int( array, newSize, errorMessage, ERR, ERROR, * )
71  INTEGER(INTG), ALLOCATABLE, INTENT(INOUT) :: array(:)
72  INTEGER(INTG), INTENT(IN) :: newSize
73  CHARACTER(LEN=*), INTENT(IN) :: errorMessage
74  INTEGER(INTG), INTENT(OUT) :: ERR
75  TYPE(varying_string), INTENT(OUT) :: ERROR
76 
77  enters("REALLOCATE_INT",err,error,*999)
78 
79  IF( ALLOCATED( array ) ) THEN
80  DEALLOCATE( array )
81  ENDIF
82 
83  ALLOCATE( array( newsize ), stat = err )
84  IF( err /= 0 ) CALL flagerror( errormessage, err, error, *999)
85 
86  array(:) = 0
87 
88  exits("REALLOCATE_INT")
89  RETURN
90 999 errorsexits("REALLOCATE_INT",err,error)
91  END SUBROUTINE reallocate_int
92 
93  !
94  !================================================================================================================================
95  !
96 
97  SUBROUTINE reallocate_real( array, newSize, errorMessage, ERR, ERROR, * )
98  REAL(DP), ALLOCATABLE, INTENT(INOUT) :: array(:)
99  INTEGER(INTG), INTENT(IN) :: newSize
100  CHARACTER(LEN=*), INTENT(IN) :: errorMessage
101  INTEGER(INTG), INTENT(OUT) :: ERR
102  TYPE(varying_string), INTENT(OUT) :: ERROR
103 
104  enters("REALLOCATE_REAL",err,error,*999)
105 
106  IF( ALLOCATED( array ) ) THEN
107  DEALLOCATE( array )
108  ENDIF
109 
110  ALLOCATE( array( newsize ), stat = err )
111  IF( err /= 0 ) CALL flagerror( errormessage, err, error, *999)
112 
113  array(:) = 0
114 
115  exits("REALLOCATE_REAL")
116  RETURN
117 999 errorsexits("REALLOCATE_REAL",err,error)
118  END SUBROUTINE reallocate_real
119 
120  !
121  !================================================================================================================================
122  !
123 
124  SUBROUTINE reallocate_string( array, newSize, errorMessage, ERR, ERROR, * )
125  TYPE(varying_string), ALLOCATABLE, INTENT(INOUT) :: array(:)
126  INTEGER(INTG), INTENT(IN) :: newSize
127  CHARACTER(LEN=*), INTENT(IN) :: errorMessage
128  INTEGER(INTG), INTENT(OUT) :: ERR
129  TYPE(varying_string), INTENT(OUT) :: ERROR
130  !Local variables
131  INTEGER(INTG) :: I
132 
133  enters("REALLOCATE_STRING",err,error,*999)
134 
135  IF( ALLOCATED( array ) ) THEN
136  DO i=1,SIZE(array,1)
137  CALL erase(array(i))
138  DEALLOCATE( array )
139  ENDDO
140  ENDIF
141 
142  ALLOCATE( array( newsize ), stat = err )
143  IF( err /= 0 ) CALL flagerror( errormessage, err, error, *999)
144 
145  exits("REALLOCATE_STRING")
146  RETURN
147 999 errorsexits("REALLOCATE_STRING",err,error)
148  END SUBROUTINE reallocate_string
149 
150  !
151  !================================================================================================================================
152  !
153 
154  SUBROUTINE reallocate_2d( array, newSize1, newSize2, errorMessage, ERR, ERROR, * )
155  INTEGER(INTG), ALLOCATABLE, INTENT(INOUT) :: array(:,:)
156  INTEGER(INTG), INTENT(IN) :: newSize1
157  INTEGER(INTG), INTENT(IN) :: newSize2
158  CHARACTER(LEN=*), INTENT(IN) :: errorMessage
159  INTEGER(INTG), INTENT(OUT) :: ERR
160  TYPE(varying_string), INTENT(OUT) :: ERROR
161 
162  enters("REALLOCATE_2D",err,error,*999)
163 
164  IF( ALLOCATED( array ) ) THEN
165  DEALLOCATE( array )
166  ENDIF
167 
168  ALLOCATE( array( newsize1, newsize2 ), stat = err )
169  IF( err /= 0 ) CALL flagerror( errormessage, err, error, *999)
170 
171  array(:,:) = 0
172 
173  exits("REALLOCATE_2D")
174  RETURN
175 999 errorsexits("REALLOCATE_2D",err,error)
176  END SUBROUTINE reallocate_2d
177 
178  !
179  !================================================================================================================================
180  !
181 
182  SUBROUTINE grow_array_int( array, delta, errorMessage, ERR, ERROR, * )
183  INTEGER(INTG), ALLOCATABLE, INTENT(INOUT) :: array(:)
184  INTEGER(INTG), INTENT(IN) :: delta
185  CHARACTER(LEN=*), INTENT(IN) :: errorMessage
186  INTEGER(INTG), INTENT(OUT) :: ERR
187  TYPE(varying_string), INTENT(OUT) :: ERROR
188 
189  INTEGER(INTG), ALLOCATABLE :: tempArray(:)
190  INTEGER(INTG) :: oldSize
191 
192  enters("GROW_ARRAY_INT",err,error,*999)
193 
194  IF( .NOT.ALLOCATED( array ) ) THEN
195  CALL reallocate( array, delta, errormessage, err, error, *999 )
196  RETURN
197  ENDIF
198 
199  oldsize = SIZE( array )
200 
201  CALL reallocate( temparray, oldsize, errormessage, err, error, *999 )
202 
203  temparray(:) = array(:)
204 
205  CALL reallocate( array, oldsize + delta, errormessage, err, error, *999 )
206 
207  array(1:oldsize) = temparray(:)
208 
209  DEALLOCATE( temparray )
210 
211  exits("GROW_ARRAY_INT")
212  RETURN
213 999 errorsexits("GROW_ARRAY_INT",err,error)
214  END SUBROUTINE grow_array_int
215 
216  !
217  !================================================================================================================================
218  !
219 
220  SUBROUTINE grow_array_real( array, delta, errorMessage, ERR, ERROR, * )
221  REAL(C_DOUBLE), ALLOCATABLE, INTENT(INOUT) :: array(:)
222  INTEGER(INTG), INTENT(IN) :: delta
223  CHARACTER(LEN=*), INTENT(IN) :: errorMessage
224  INTEGER(INTG), INTENT(OUT) :: ERR
225  TYPE(varying_string), INTENT(OUT) :: ERROR
226 
227  REAL(C_DOUBLE), ALLOCATABLE :: tempArray(:)
228  INTEGER(INTG) :: oldSize
229 
230  enters("GROW_ARRAY_REAL",err,error,*999)
231 
232  IF( .NOT.ALLOCATED( array ) ) THEN
233  CALL reallocate( array, delta, errormessage, err, error, *999 )
234  RETURN
235  ENDIF
236 
237  oldsize = SIZE( array )
238 
239  CALL reallocate( temparray, oldsize, errormessage, err, error, *999 )
240 
241  temparray(:) = array(:)
242 
243  CALL reallocate( array, oldsize + delta, errormessage, err, error, *999 )
244 
245  array(1:oldsize) = temparray(:)
246 
247  DEALLOCATE( temparray )
248 
249  exits("GROW_ARRAY_REAL")
250  RETURN
251 999 errorsexits("GROW_ARRAY_REAL",err,error)
252  END SUBROUTINE grow_array_real
253 
254  !
255  !================================================================================================================================
256  !
257 
258 END MODULE util_array
base_routines::enters
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Definition: base_routines.f90:363
util_array::reallocate_real
subroutine reallocate_real(array, newSize, errorMessage, ERR, ERROR,)
Definition: util_array.f90:98
util_array::reallocate
Definition: util_array.f90:51
util_array
Implements various dynamic array routines.
Definition: util_array.f90:43
util_array::reallocate_2d
subroutine reallocate_2d(array, newSize1, newSize2, errorMessage, ERR, ERROR,)
Definition: util_array.f90:155
util_array::grow_array
Definition: util_array.f90:57
base_routines::exits
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Definition: base_routines.f90:504
types
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
base_routines
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
Definition: base_routines.f90:45
util_array::reallocate_int
subroutine reallocate_int(array, newSize, errorMessage, ERR, ERROR,)
Definition: util_array.f90:71
util_array::reallocate_string
subroutine reallocate_string(array, newSize, errorMessage, ERR, ERROR,)
Definition: util_array.f90:125
util_array::grow_array_real
subroutine grow_array_real(array, delta, errorMessage, ERR, ERROR,)
Definition: util_array.f90:221
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
util_array::grow_array_int
subroutine grow_array_int(array, delta, errorMessage, ERR, ERROR,)
Definition: util_array.f90:183