52 REAL(mpd),
DIMENSION(:),
INTENT(IN OUT),
ALLOCATABLE :: array
53 INTEGER(mpl),
INTENT(IN) :: length
54 CHARACTER (LEN=*),
INTENT(IN) :: text
57 ALLOCATE (array(length),stat=ifail)
63 REAL(mps),
DIMENSION(:),
INTENT(IN OUT),
ALLOCATABLE :: array
64 INTEGER(mpl),
INTENT(IN) :: length
65 CHARACTER (LEN=*),
INTENT(IN) :: text
68 ALLOCATE (array(length),stat=ifail)
74 INTEGER(mpi),
DIMENSION(:),
INTENT(IN OUT),
ALLOCATABLE :: array
75 INTEGER(mpl),
INTENT(IN) :: length
76 CHARACTER (LEN=*),
INTENT(IN) :: text
79 ALLOCATE (array(length),stat=ifail)
85 INTEGER(mpl),
DIMENSION(:),
INTENT(IN OUT),
ALLOCATABLE :: array
86 INTEGER(mpl),
INTENT(IN) :: length
87 CHARACTER (LEN=*),
INTENT(IN) :: text
90 ALLOCATE (array(length),stat=ifail)
96 REAL(mps),
DIMENSION(:,:),
INTENT(IN OUT),
ALLOCATABLE :: array
97 INTEGER(mpl),
INTENT(IN) :: rows
98 INTEGER(mpl),
INTENT(IN) :: cols
99 CHARACTER (LEN=*),
INTENT(IN) :: text
101 INTEGER(mpi) :: ifail
102 ALLOCATE (array(rows,cols),stat=ifail)
108 INTEGER(mpi),
DIMENSION(:,:),
INTENT(IN OUT),
ALLOCATABLE :: array
109 INTEGER(mpl),
INTENT(IN) :: rows
110 INTEGER(mpl),
INTENT(IN) :: cols
111 CHARACTER (LEN=*),
INTENT(IN) :: text
113 INTEGER(mpi) :: ifail
114 ALLOCATE (array(rows,cols),stat=ifail)
120 INTEGER(mpl),
DIMENSION(:,:),
INTENT(IN OUT),
ALLOCATABLE :: array
121 INTEGER(mpl),
INTENT(IN) :: rows
122 INTEGER(mpl),
INTENT(IN) :: cols
123 CHARACTER (LEN=*),
INTENT(IN) :: text
125 INTEGER(mpi) :: ifail
126 ALLOCATE (array(rows,cols),stat=ifail)
132 TYPE(
listitem),
DIMENSION(:),
INTENT(IN OUT),
ALLOCATABLE :: array
133 INTEGER(mpl),
INTENT(IN) :: length
134 CHARACTER (LEN=*),
INTENT(IN) :: text
136 INTEGER(mpi) :: ifail
137 ALLOCATE (array(length),stat=ifail)
143 TYPE(
listitemc),
DIMENSION(:),
INTENT(IN OUT),
ALLOCATABLE :: array
144 INTEGER(mpl),
INTENT(IN) :: length
145 CHARACTER (LEN=*),
INTENT(IN) :: text
147 INTEGER(mpi) :: ifail
148 ALLOCATE (array(length),stat=ifail)
154 TYPE(
listitemi),
DIMENSION(:),
INTENT(IN OUT),
ALLOCATABLE :: array
155 INTEGER(mpl),
INTENT(IN) :: length
156 CHARACTER (LEN=*),
INTENT(IN) :: text
158 INTEGER(mpi) :: ifail
159 ALLOCATE (array(length),stat=ifail)
165 CHARACTER,
DIMENSION(:),
INTENT(IN OUT),
ALLOCATABLE :: array
166 INTEGER(mpl),
INTENT(IN) :: length
167 CHARACTER (LEN=*),
INTENT(IN) :: text
169 INTEGER(mpi) :: ifail
170 ALLOCATE (array(length),stat=ifail)
176 INTEGER(mpi),
INTENT(IN) :: ifail
177 INTEGER(mpl),
INTENT(IN) :: numwords
178 CHARACTER (LEN=*),
INTENT(IN) :: text
184 print *,
' MPALLOC allocated ', numwords,
' words for : ', text
188 print *,
' MPALLOC failed to allocate ', numwords,
' words for : ', text
190 print *,
' MPALLOC stat = ', ifail
191 CALL peend(30,
'Aborted, memory allocation failed')
198 REAL(mpd),
DIMENSION(:),
INTENT(IN OUT),
ALLOCATABLE :: array
200 INTEGER(mpi) :: ifail
201 INTEGER(mpl) :: isize
202 isize = (mpd*
size(array,kind=
mpl))/
mpi
203 DEALLOCATE (array,stat=ifail)
209 REAL(mps),
DIMENSION(:),
INTENT(IN OUT),
ALLOCATABLE :: array
211 INTEGER(mpi) :: ifail
212 INTEGER(mpl) :: isize
213 isize = (mps*
size(array,kind=
mpl))/
mpi
214 DEALLOCATE (array,stat=ifail)
220 INTEGER(mpi),
DIMENSION(:),
INTENT(IN OUT),
ALLOCATABLE :: array
222 INTEGER(mpi) :: ifail
223 INTEGER(mpl) :: isize
224 isize =
size(array,kind=
mpl)
225 DEALLOCATE (array,stat=ifail)
231 INTEGER(mpl),
DIMENSION(:),
INTENT(IN OUT),
ALLOCATABLE :: array
233 INTEGER(mpi) :: ifail
234 INTEGER(mpl) :: isize
235 isize =
size(array,kind=
mpl)
236 DEALLOCATE (array,stat=ifail)
242 REAL(mps),
DIMENSION(:,:),
INTENT(IN OUT),
ALLOCATABLE :: array
244 INTEGER(mpi) :: ifail
245 INTEGER(mpl) :: isize
246 isize = (mps*
size(array,kind=
mpl))/
mpi
247 DEALLOCATE (array,stat=ifail)
253 INTEGER(mpi),
DIMENSION(:,:),
INTENT(IN OUT),
ALLOCATABLE :: array
255 INTEGER(mpi) :: ifail
256 INTEGER(mpl) :: isize
257 isize =
size(array,kind=
mpl)
258 DEALLOCATE (array,stat=ifail)
264 INTEGER(mpl),
DIMENSION(:,:),
INTENT(IN OUT),
ALLOCATABLE :: array
266 INTEGER(mpi) :: ifail
267 INTEGER(mpl) :: isize
269 DEALLOCATE (array,stat=ifail)
275 TYPE(
listitem),
DIMENSION(:),
INTENT(IN OUT),
ALLOCATABLE :: array
277 INTEGER(mpi) :: ifail
278 INTEGER(mpl) :: isize
280 DEALLOCATE (array,stat=ifail)
286 TYPE(
listitemc),
DIMENSION(:),
INTENT(IN OUT),
ALLOCATABLE :: array
288 INTEGER(mpi) :: ifail
289 INTEGER(mpl) :: isize
291 DEALLOCATE (array,stat=ifail)
297 TYPE(
listitemi),
DIMENSION(:),
INTENT(IN OUT),
ALLOCATABLE :: array
299 INTEGER(mpi) :: ifail
300 INTEGER(mpl) :: isize
302 DEALLOCATE (array,stat=ifail)
308 CHARACTER,
DIMENSION(:),
INTENT(IN OUT),
ALLOCATABLE :: array
310 INTEGER(mpi) :: ifail
311 INTEGER(mpl) :: isize
313 DEALLOCATE (array,stat=ifail)
319 INTEGER(mpi),
INTENT(IN) :: ifail
320 INTEGER(mpl),
INTENT(IN) :: numwords
325 print *,
' MPDEALLOC deallocated ', numwords,
' words '
329 print *,
' MPDEALLOC failed to deallocate ', numwords,
' words'
331 print *,
' MPDEALLOC stat = ', ifail
332 CALL peend(31,
'Aborted, memory deallocation failed')
(De)Allocate vectors and arrays.
subroutine mpdeallocfvec(array)
deallocate (1D) single precision array
subroutine mpalloclist(array, length, text)
allocate (1D) list item array
subroutine mpallocivec(array, length, text)
allocate (1D) integer array
subroutine mpalloclarr(array, rows, cols, text)
allocate (2D) large integer array
subroutine mpdealloccvec(array)
deallocate (1D) character array
subroutine mpallocfvec(array, length, text)
allocate (1D) single precision array
subroutine mpalloclisti(array, length, text)
allocate (1D) character list item array
subroutine mpalloccvec(array, length, text)
allocate (1D) character array
integer(mpl) maxwordsalloc
peak dynamic memory allocation (words)
integer(mpi) nummpdealloc
number of dynamic deallocations
integer(mpi) printflagalloc
print flag for dynamic allocations
subroutine mpdealloclisti(array)
deallocate (1D) integer list item array
subroutine mpalloclistc(array, length, text)
allocate (1D) character list item array
subroutine mpdealloclistc(array)
deallocate (1D) character list item array
subroutine mpdeallocdvec(array)
deallocate (1D) double precision array
subroutine mpdealloccheck(ifail, numwords)
check deallocation
subroutine mpdealloclarr(array)
deallocate (2D) large integer array
subroutine mpalloccheck(ifail, numwords, text)
check allocation
subroutine mpallocfarr(array, rows, cols, text)
allocate (2D) single precision array
integer(mpl) numwordsalloc
current dynamic memory allocation (words)
subroutine mpdeallocivec(array)
deallocate (1D) integer array
integer(mpi) nummpalloc
number of dynamic allocations
subroutine mpdealloclvec(array)
deallocate (1D) large integer array
subroutine mpallociarr(array, rows, cols, text)
allocate (2D) INTEGER(mpi) array
subroutine mpdealloclist(array)
deallocate (1D) list item array
subroutine mpalloclvec(array, length, text)
allocate (1D) large integer array
subroutine mpallocdvec(array, length, text)
allocate (1D) double precision array
subroutine mpdeallociarr(array)
deallocate (2D) integer array
subroutine mpdeallocfarr(array)
deallocate (2D) single precision array
integer, parameter mpl
long integer
integer, parameter itemclen
comment length (60 characters)
integer, parameter mps
single precision
integer, parameter mpi
integer
subroutine peend(icode, cmessage)
Print exit code.
list items from steering file
character list items from steering file
integer list items from steering file