Millepede-II: mpdalc.f90 Source File

Go to the documentation of this file.
00001 
00005 
00007 MODULE mpdalc
00008     USE mpdef
00009     IMPLICIT NONE
00010     SAVE
00011     ! variables
00012     INTEGER(kind=large) :: numwordsalloc = 0 !< current dynamic memory allocation (words)
00013     INTEGER(kind=large) :: maxwordsalloc = 0 !< peak dynamic memory allocation (words)
00014     INTEGER :: nummpalloc = 0     !< number of dynamic allocations
00015     INTEGER :: nummpdealloc = 0   !< number of dynamic deallocations
00016     INTEGER :: printflagalloc = 0 !< print flag for dynamic allocations
00017 
00019     INTERFACE mpalloc
00020         MODULE PROCEDURE mpallocdvec, mpallocfvec, mpallocivec, &
00021         mpallocfarr, mpallociarr, mpalloclarr, mpalloclist, mpalloccvec
00022     END INTERFACE mpalloc
00024     INTERFACE mpdealloc
00025         MODULE PROCEDURE mpdeallocdvec, mpdeallocfvec, mpdeallocivec, &
00026         mpdeallocfarr, mpdeallociarr, mpdealloclarr, mpdealloclist, mpdealloccvec
00027     END INTERFACE mpdealloc
00028 
00029 CONTAINS
00030     ! allocate dynamic vector or array
00032     SUBROUTINE mpallocdvec(array,length,text)
00033         DOUBLE PRECISION, DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
00034         INTEGER(kind=large), INTENT(IN) :: length
00035         CHARACTER (LEN=*), INTENT(IN) :: text
00036 
00037         INTEGER :: ifail
00038         ALLOCATE (array(length),stat=ifail)
00039         CALL mpalloccheck(ifail,2*length,text)
00040     END SUBROUTINE mpallocdvec
00041 
00043     SUBROUTINE mpallocfvec(array,length,text)
00044         REAL, DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
00045         INTEGER(kind=large), INTENT(IN) :: length
00046         CHARACTER (LEN=*), INTENT(IN) :: text
00047 
00048         INTEGER :: ifail
00049         ALLOCATE (array(length),stat=ifail)
00050         CALL mpalloccheck(ifail,length,text)
00051     END SUBROUTINE mpallocfvec
00052 
00054     SUBROUTINE mpallocivec(array,length,text)
00055         INTEGER, DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
00056         INTEGER(kind=large), INTENT(IN) :: length
00057         CHARACTER (LEN=*), INTENT(IN) :: text
00058 
00059         INTEGER :: ifail
00060         ALLOCATE (array(length),stat=ifail)
00061         CALL mpalloccheck(ifail,length,text)
00062     END SUBROUTINE mpallocivec
00063 
00065     SUBROUTINE mpallocfarr(array,rows,cols,text)
00066         REAL, DIMENSION(:,:), INTENT(IN OUT), ALLOCATABLE :: array
00067         INTEGER(kind=large), INTENT(IN) :: rows
00068         INTEGER(kind=large), INTENT(IN) :: cols
00069         CHARACTER (LEN=*), INTENT(IN)  :: text
00070 
00071         INTEGER :: ifail
00072         ALLOCATE (array(rows,cols),stat=ifail)
00073         CALL mpalloccheck(ifail,rows*cols,text)
00074     END SUBROUTINE mpallocfarr
00075 
00077     SUBROUTINE mpallociarr(array,rows,cols,text)
00078         INTEGER, DIMENSION(:,:), INTENT(IN OUT), ALLOCATABLE :: array
00079         INTEGER(kind=large), INTENT(IN) :: rows
00080         INTEGER(kind=large), INTENT(IN) :: cols
00081         CHARACTER (LEN=*), INTENT(IN)  :: text
00082 
00083         INTEGER :: ifail
00084         ALLOCATE (array(rows,cols),stat=ifail)
00085         CALL mpalloccheck(ifail,rows*cols,text)
00086     END SUBROUTINE mpallociarr
00087 
00089     SUBROUTINE mpalloclarr(array,rows,cols,text)
00090         INTEGER(kind=large), DIMENSION(:,:), INTENT(IN OUT), ALLOCATABLE :: array
00091         INTEGER(kind=large), INTENT(IN) :: rows
00092         INTEGER(kind=large), INTENT(IN) :: cols
00093         CHARACTER (LEN=*), INTENT(IN)  :: text
00094 
00095         INTEGER :: ifail
00096         ALLOCATE (array(rows,cols),stat=ifail)
00097         CALL mpalloccheck(ifail,rows*cols*large/4,text)
00098     END SUBROUTINE mpalloclarr
00099 
00101     SUBROUTINE mpalloclist(array,length,text)
00102         TYPE(listItem), DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
00103         INTEGER(kind=large), INTENT(IN) :: length
00104         CHARACTER (LEN=*), INTENT(IN) :: text
00105 
00106         INTEGER :: ifail
00107         ALLOCATE (array(length),stat=ifail)
00108         CALL mpalloccheck(ifail,length*2,text)
00109     END SUBROUTINE mpalloclist
00110 
00112     SUBROUTINE mpalloccvec(array,length,text)
00113         CHARACTER, DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
00114         INTEGER(kind=large), INTENT(IN) :: length
00115         CHARACTER (LEN=*), INTENT(IN) :: text
00116 
00117         INTEGER :: ifail
00118         ALLOCATE (array(length),stat=ifail)
00119         CALL mpalloccheck(ifail,(length+3)/4,text)
00120     END SUBROUTINE mpalloccvec
00121 
00123     SUBROUTINE mpalloccheck(ifail,numwords,text)
00124         INTEGER, INTENT(IN) :: ifail
00125         INTEGER(kind=large), INTENT(IN) :: numwords
00126         CHARACTER (LEN=*), INTENT(IN)  :: text
00127         IF (ifail == 0) THEN
00128             nummpalloc=nummpalloc+1
00129             numwordsalloc = numwordsalloc + numwords
00130             maxwordsalloc = MAX(maxwordsalloc, numwordsalloc)
00131             IF (printflagalloc /= 0) THEN
00132                 print *, ' MPALLOC allocated ', numwords, ' words for : ', text
00133                 print *, ' words used ', numwordsalloc, maxwordsalloc
00134             ENDIF
00135         ELSE
00136             print *, ' MPALLOC failed to allocate ', numwords, ' words for : ', text
00137             print *, ' MPALLOC words used ', numwordsalloc, maxwordsalloc
00138             print *, ' MPALLOC stat = ', ifail
00139             STOP
00140         ENDIF
00141     END SUBROUTINE mpalloccheck
00142     ! deallocate dynamic vector or array
00144     SUBROUTINE mpdeallocdvec(array)
00145         DOUBLE PRECISION, DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
00146 
00147         INTEGER :: ifail
00148         INTEGER(kind=large) :: isize
00149         isize = 2*size(array,kind=large)
00150         DEALLOCATE (array,stat=ifail)
00151         CALL mpdealloccheck(ifail,isize)
00152     END SUBROUTINE mpdeallocdvec
00153 
00155     SUBROUTINE mpdeallocfvec(array)
00156         REAL, DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
00157 
00158         INTEGER :: ifail
00159         INTEGER(kind=large) :: isize
00160         isize = size(array,kind=large)
00161         DEALLOCATE (array,stat=ifail)
00162         CALL mpdealloccheck(ifail,isize)
00163     END SUBROUTINE mpdeallocfvec
00164 
00166     SUBROUTINE mpdeallocivec(array)
00167         INTEGER, DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
00168 
00169         INTEGER :: ifail
00170         INTEGER(kind=large) :: isize
00171         isize = size(array,kind=large)
00172         DEALLOCATE (array,stat=ifail)
00173         CALL mpdealloccheck(ifail,isize)
00174     END SUBROUTINE mpdeallocivec
00175 
00177     SUBROUTINE mpdeallocfarr(array)
00178         REAL, DIMENSION(:,:), INTENT(IN OUT), ALLOCATABLE :: array
00179 
00180         INTEGER :: ifail
00181         INTEGER(kind=large) :: isize
00182         isize = size(array,kind=large)
00183         DEALLOCATE (array,stat=ifail)
00184         CALL mpdealloccheck(ifail,isize)
00185     END SUBROUTINE mpdeallocfarr
00186 
00188     SUBROUTINE mpdeallociarr(array)
00189         INTEGER, DIMENSION(:,:), INTENT(IN OUT), ALLOCATABLE :: array
00190 
00191         INTEGER :: ifail
00192         INTEGER(kind=large) :: isize
00193         isize = size(array,kind=large)
00194         DEALLOCATE (array,stat=ifail)
00195         CALL mpdealloccheck(ifail,isize)
00196     END SUBROUTINE mpdeallociarr
00197 
00199     SUBROUTINE mpdealloclarr(array)
00200         INTEGER(kind=large), DIMENSION(:,:), INTENT(IN OUT), ALLOCATABLE :: array
00201 
00202         INTEGER :: ifail
00203         INTEGER(kind=large) :: isize
00204         isize = size(array,kind=large)*large/4
00205         DEALLOCATE (array,stat=ifail)
00206         CALL mpdealloccheck(ifail,isize)
00207     END SUBROUTINE mpdealloclarr
00208 
00210     SUBROUTINE mpdealloclist(array)
00211         TYPE(listItem), DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
00212 
00213         INTEGER :: ifail
00214         INTEGER(kind=large) :: isize
00215         isize = 2*size(array,kind=large)
00216         DEALLOCATE (array,stat=ifail)
00217         CALL mpdealloccheck(ifail,isize)
00218     END SUBROUTINE mpdealloclist
00219 
00221     SUBROUTINE mpdealloccvec(array)
00222         CHARACTER, DIMENSION(:), INTENT(IN OUT), ALLOCATABLE :: array
00223 
00224         INTEGER :: ifail
00225         INTEGER(kind=large) :: isize
00226         isize = (size(array,kind=large)+3)/4
00227         DEALLOCATE (array,stat=ifail)
00228         CALL mpdealloccheck(ifail,isize)
00229     END SUBROUTINE mpdealloccvec
00230 
00232     SUBROUTINE mpdealloccheck(ifail,numwords)
00233         INTEGER, INTENT(IN) :: ifail
00234         INTEGER(kind=large), INTENT(IN) :: numwords
00235         IF (ifail == 0) THEN
00236             numwordsalloc = numwordsalloc - numwords
00237             nummpdealloc=nummpdealloc+1
00238             IF (printflagalloc /= 0) THEN
00239                 print *, ' MPDEALLOC deallocated ', numwords, ' words '
00240                 print *, ' words used ', numwordsalloc, maxwordsalloc
00241             ENDIF
00242         ELSE
00243             print *, ' MPDEALLOC failed to deallocate ', numwords, ' words'
00244             print *, ' MPDEALLOC words used ', numwordsalloc, maxwordsalloc
00245             print *, ' MPDEALLOC stat = ', ifail
00246             STOP
00247         ENDIF
00248     END SUBROUTINE mpdealloccheck
00249 
00250 END MODULE mpdalc