Millepede-II  V04-00-00_preview
 All Classes Files Functions Variables Enumerator Pages
mpdalc.f90
Go to the documentation of this file.
1 
5 
7 MODULE mpdalc
8  USE mpdef
9  IMPLICIT NONE
10  SAVE
11  ! variables
12  INTEGER(kind=large) :: numwordsalloc = 0 !< current dynamic memory allocation (words)
13  INTEGER(kind=large) :: maxwordsalloc = 0 !< peak dynamic memory allocation (words)
14  INTEGER :: nummpalloc = 0 !< number of dynamic allocations
15  INTEGER :: nummpdealloc = 0 !< number of dynamic deallocations
16  INTEGER :: printflagalloc = 0 !< print flag for dynamic allocations
17 
19  INTERFACE mpalloc
20  MODULE PROCEDURE mpallocdvec, mpallocfvec, mpallocivec, &
21  mpallocfarr, mpallociarr, mpalloclarr, mpalloclist, mpalloccvec
22  END INTERFACE mpalloc
24  INTERFACE mpdealloc
25  MODULE PROCEDURE mpdeallocdvec, mpdeallocfvec, mpdeallocivec, &
26  mpdeallocfarr, mpdeallociarr, mpdealloclarr, mpdealloclist, mpdealloccvec
27  END INTERFACE mpdealloc
28 
29 CONTAINS
30  ! allocate dynamic vector or array
32  SUBROUTINE mpallocdvec(array,length,text)
33  DOUBLE PRECISION, DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
34  INTEGER(kind=large), INTENT(IN) :: length
35  CHARACTER (LEN=*), INTENT(IN) :: text
36 
37  INTEGER :: ifail
38  ALLOCATE (array(length),stat=ifail)
39  CALL mpalloccheck(ifail,2*length,text)
40  END SUBROUTINE mpallocdvec
41 
43  SUBROUTINE mpallocfvec(array,length,text)
44  REAL, DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
45  INTEGER(kind=large), INTENT(IN) :: length
46  CHARACTER (LEN=*), INTENT(IN) :: text
47 
48  INTEGER :: ifail
49  ALLOCATE (array(length),stat=ifail)
50  CALL mpalloccheck(ifail,length,text)
51  END SUBROUTINE mpallocfvec
52 
54  SUBROUTINE mpallocivec(array,length,text)
55  INTEGER, DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
56  INTEGER(kind=large), INTENT(IN) :: length
57  CHARACTER (LEN=*), INTENT(IN) :: text
58 
59  INTEGER :: ifail
60  ALLOCATE (array(length),stat=ifail)
61  CALL mpalloccheck(ifail,length,text)
62  END SUBROUTINE mpallocivec
63 
65  SUBROUTINE mpallocfarr(array,rows,cols,text)
66  REAL, DIMENSION(:,:), INTENT(IN OUT), ALLOCATABLE :: array
67  INTEGER(kind=large), INTENT(IN) :: rows
68  INTEGER(kind=large), INTENT(IN) :: cols
69  CHARACTER (LEN=*), INTENT(IN) :: text
70 
71  INTEGER :: ifail
72  ALLOCATE (array(rows,cols),stat=ifail)
73  CALL mpalloccheck(ifail,rows*cols,text)
74  END SUBROUTINE mpallocfarr
75 
77  SUBROUTINE mpallociarr(array,rows,cols,text)
78  INTEGER, DIMENSION(:,:), INTENT(IN OUT), ALLOCATABLE :: array
79  INTEGER(kind=large), INTENT(IN) :: rows
80  INTEGER(kind=large), INTENT(IN) :: cols
81  CHARACTER (LEN=*), INTENT(IN) :: text
82 
83  INTEGER :: ifail
84  ALLOCATE (array(rows,cols),stat=ifail)
85  CALL mpalloccheck(ifail,rows*cols,text)
86  END SUBROUTINE mpallociarr
87 
89  SUBROUTINE mpalloclarr(array,rows,cols,text)
90  INTEGER(kind=large), DIMENSION(:,:), INTENT(IN OUT), ALLOCATABLE :: array
91  INTEGER(kind=large), INTENT(IN) :: rows
92  INTEGER(kind=large), INTENT(IN) :: cols
93  CHARACTER (LEN=*), INTENT(IN) :: text
94 
95  INTEGER :: ifail
96  ALLOCATE (array(rows,cols),stat=ifail)
97  CALL mpalloccheck(ifail,rows*cols*large/4,text)
98  END SUBROUTINE mpalloclarr
99 
101  SUBROUTINE mpalloclist(array,length,text)
102  TYPE(listitem), DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
103  INTEGER(kind=large), INTENT(IN) :: length
104  CHARACTER (LEN=*), INTENT(IN) :: text
105 
106  INTEGER :: ifail
107  ALLOCATE (array(length),stat=ifail)
108  CALL mpalloccheck(ifail,length*2,text)
109  END SUBROUTINE mpalloclist
110 
112  SUBROUTINE mpalloccvec(array,length,text)
113  CHARACTER, DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
114  INTEGER(kind=large), INTENT(IN) :: length
115  CHARACTER (LEN=*), INTENT(IN) :: text
116 
117  INTEGER :: ifail
118  ALLOCATE (array(length),stat=ifail)
119  CALL mpalloccheck(ifail,(length+3)/4,text)
120  END SUBROUTINE mpalloccvec
121 
123  SUBROUTINE mpalloccheck(ifail,numwords,text)
124  INTEGER, INTENT(IN) :: ifail
125  INTEGER(kind=large), INTENT(IN) :: numwords
126  CHARACTER (LEN=*), INTENT(IN) :: text
127  IF (ifail == 0) THEN
128  nummpalloc=nummpalloc+1
129  numwordsalloc = numwordsalloc + numwords
130  maxwordsalloc = max(maxwordsalloc, numwordsalloc)
131  IF (printflagalloc /= 0) THEN
132  print *, ' MPALLOC allocated ', numwords, ' words for : ', text
133  print *, ' words used ', numwordsalloc, maxwordsalloc
134  ENDIF
135  ELSE
136  print *, ' MPALLOC failed to allocate ', numwords, ' words for : ', text
137  print *, ' MPALLOC words used ', numwordsalloc, maxwordsalloc
138  print *, ' MPALLOC stat = ', ifail
139  stop
140  ENDIF
141  END SUBROUTINE mpalloccheck
142  ! deallocate dynamic vector or array
144  SUBROUTINE mpdeallocdvec(array)
145  DOUBLE PRECISION, DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
146 
147  INTEGER :: ifail
148  INTEGER(kind=large) :: isize
149  isize = 2*size(array,kind=large)
150  DEALLOCATE (array,stat=ifail)
151  CALL mpdealloccheck(ifail,isize)
152  END SUBROUTINE mpdeallocdvec
153 
155  SUBROUTINE mpdeallocfvec(array)
156  REAL, DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
157 
158  INTEGER :: ifail
159  INTEGER(kind=large) :: isize
160  isize = size(array,kind=large)
161  DEALLOCATE (array,stat=ifail)
162  CALL mpdealloccheck(ifail,isize)
163  END SUBROUTINE mpdeallocfvec
164 
166  SUBROUTINE mpdeallocivec(array)
167  INTEGER, DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
168 
169  INTEGER :: ifail
170  INTEGER(kind=large) :: isize
171  isize = size(array,kind=large)
172  DEALLOCATE (array,stat=ifail)
173  CALL mpdealloccheck(ifail,isize)
174  END SUBROUTINE mpdeallocivec
175 
177  SUBROUTINE mpdeallocfarr(array)
178  REAL, DIMENSION(:,:), INTENT(IN OUT), ALLOCATABLE :: array
179 
180  INTEGER :: ifail
181  INTEGER(kind=large) :: isize
182  isize = size(array,kind=large)
183  DEALLOCATE (array,stat=ifail)
184  CALL mpdealloccheck(ifail,isize)
185  END SUBROUTINE mpdeallocfarr
186 
188  SUBROUTINE mpdeallociarr(array)
189  INTEGER, DIMENSION(:,:), INTENT(IN OUT), ALLOCATABLE :: array
190 
191  INTEGER :: ifail
192  INTEGER(kind=large) :: isize
193  isize = size(array,kind=large)
194  DEALLOCATE (array,stat=ifail)
195  CALL mpdealloccheck(ifail,isize)
196  END SUBROUTINE mpdeallociarr
197 
199  SUBROUTINE mpdealloclarr(array)
200  INTEGER(kind=large), DIMENSION(:,:), INTENT(IN OUT), ALLOCATABLE :: array
201 
202  INTEGER :: ifail
203  INTEGER(kind=large) :: isize
204  isize = size(array,kind=large)*large/4
205  DEALLOCATE (array,stat=ifail)
206  CALL mpdealloccheck(ifail,isize)
207  END SUBROUTINE mpdealloclarr
208 
210  SUBROUTINE mpdealloclist(array)
211  TYPE(listitem), DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
212 
213  INTEGER :: ifail
214  INTEGER(kind=large) :: isize
215  isize = 2*size(array,kind=large)
216  DEALLOCATE (array,stat=ifail)
217  CALL mpdealloccheck(ifail,isize)
218  END SUBROUTINE mpdealloclist
219 
221  SUBROUTINE mpdealloccvec(array)
222  CHARACTER, DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
223 
224  INTEGER :: ifail
225  INTEGER(kind=large) :: isize
226  isize = (size(array,kind=large)+3)/4
227  DEALLOCATE (array,stat=ifail)
228  CALL mpdealloccheck(ifail,isize)
229  END SUBROUTINE mpdealloccvec
230 
232  SUBROUTINE mpdealloccheck(ifail,numwords)
233  INTEGER, INTENT(IN) :: ifail
234  INTEGER(kind=large), INTENT(IN) :: numwords
235  IF (ifail == 0) THEN
236  numwordsalloc = numwordsalloc - numwords
237  nummpdealloc=nummpdealloc+1
238  IF (printflagalloc /= 0) THEN
239  print *, ' MPDEALLOC deallocated ', numwords, ' words '
240  print *, ' words used ', numwordsalloc, maxwordsalloc
241  ENDIF
242  ELSE
243  print *, ' MPDEALLOC failed to deallocate ', numwords, ' words'
244  print *, ' MPDEALLOC words used ', numwordsalloc, maxwordsalloc
245  print *, ' MPDEALLOC stat = ', ifail
246  stop
247  ENDIF
248  END SUBROUTINE mpdealloccheck
249 
250 END MODULE mpdalc
Generated on Wed May 23 2012 16:53:05 for Millepede-II by   doxygen 1.8.1