Commit 2f7c1a73 authored by Claus Kleinwort's avatar Claus Kleinwort
Browse files

improvements for detailed input checking

git-svn-id: http://svnsrv.desy.de/public/MillepedeII/trunk@167 3547b9b0-65b8-46d3-b95d-921b3f43af62
parent 9c40bb50
......@@ -28,14 +28,18 @@
!! first column and their number for continous regions (encoded in single INTEGER(mpi) words).
!! Rare elements may be stored in single precision.
!!
!! An additional bit map is used to monitor the parameter pairs for measurements (or 'equations').
!!
!> Bit field data.
MODULE mpbits
USE mpdef
IMPLICIT NONE
INTEGER(mpl) :: ndimb !< dimension for bit (field) array
INTEGER(mpi) :: n !< matrix size
INTEGER(mpl) :: ndimb !< dimension for bit (field) array
INTEGER(mpl) :: ndimb2 !< dimension for bit map
INTEGER(mpi) :: n !< matrix size (counters)
INTEGER(mpi) :: n2 !< matrix size (map)
INTEGER(mpi) :: ibfw !< bit field width
INTEGER(mpi) :: ireqpe !< min number of pair entries
INTEGER(mpi) :: isngpe !< upper bound for pair entry single precision storage
......@@ -46,7 +50,8 @@ MODULE mpbits
INTEGER(mpi) :: nencdm !< max value for column counter
INTEGER(mpi) :: nencdb !< number of bits for encoding column counter
INTEGER(mpi) :: nthrd !< number of threads
INTEGER(mpi), DIMENSION(:), ALLOCATABLE :: bitFieldCounters !< fit field counters for global parameters pairs
INTEGER(mpi), DIMENSION(:), ALLOCATABLE :: bitFieldCounters !< fit field counters for global parameters pairs (tracks)
INTEGER(mpi), DIMENSION(:), ALLOCATABLE :: bitMap !< fit field map for global parameters pairs (measurements)
INTEGER(mpi), PARAMETER :: bs = BIT_SIZE(1_mpi) !< number of bits in INTEGER(mpi)
END MODULE mpbits
......@@ -717,3 +722,103 @@ SUBROUTINE spbits(nsparr,nsparc,ncmprs) ! collect elements
END SUBROUTINE spbits
!> Clear (additional) bit map.
!!
!! \param [in] in matrix size
!
SUBROUTINE clbmap(in)
USE mpbits
USE mpdalc
INTEGER(mpi), INTENT(IN) :: in
INTEGER(mpl) :: noffd
INTEGER(mpi) :: mb
! save input parameter
n2=in
! bit field array size
noffd=INT(n2,mpl)*INT(n2-1,mpl)/2
ndimb2=noffd/bs+n2
mb=INT(4.0E-6*REAL(ndimb2,mps),mpi)
WRITE(*,*) ' '
IF (mb > 0) THEN
WRITE(*,*) 'CLBMAP: dimension of bit-map',ndimb2 , '(',mb,'MB)'
ELSE
WRITE(*,*) 'CLBMAP: dimension of bit-map',ndimb2 , '(< 1 MB)'
END IF
CALL mpalloc(bitMap,ndimb2,'INBMAP: bit storage')
bitMap=0
RETURN
END SUBROUTINE clbmap
!> Fill bit map.
!!
!! \param [in] im first index
!! \param [in] jm second index
!!
SUBROUTINE inbmap(im,jm) ! include element (I,J)
USE mpbits
INTEGER(mpi), INTENT(IN) :: im
INTEGER(mpi), INTENT(IN) :: jm
INTEGER(mpl) :: l
INTEGER(mpi) :: i
INTEGER(mpi) :: j
INTEGER(mpi) :: noffj
INTEGER(mpl) :: noffi
INTEGER(mpi) :: m
IF(im == jm) RETURN ! diagonal
j=MIN(im,jm)
i=MAX(im,jm)
IF(j <= 0) RETURN ! out low
IF(i > n2) RETURN ! out high
noffi=INT(i-1,mpl)*INT(i-2,mpl)/2 ! for J=1
noffj=(j-1)
l=noffi/bs+i+noffj/bs ! row offset + column offset
! add I instead of 1 to keep bit maps of different rows in different words (openMP !)
m=MOD(noffj,bs)
bitMap(l)=ibset(bitMap(l),m)
RETURN
END SUBROUTINE inbmap
!> Get pairs (statistic) from map.
!!
!! \param [out] npair number of paired parameters
!!
SUBROUTINE gpbmap(npair)
USE mpbits
INTEGER(mpi), DIMENSION(:), INTENT(OUT) :: npair
INTEGER(mpl) :: l
INTEGER(mpl) :: noffi
INTEGER(mpi) :: i
INTEGER(mpi) :: j
INTEGER(mpi) :: m
LOGICAL :: btest
npair(1:n2)=0
l=0
DO i=1,n2
noffi=INT(i-1,mpl)*INT(i-2,mpl)/2
l=noffi/bs+i
m=0
DO j=1,i-1
IF (btest(bitMap(l),m)) THEN
npair(i)=npair(i)+1
npair(j)=npair(j)+1
END IF
m=m+1
IF (m >= bs) THEN
l=l+1
m=m-bs
END IF
END DO
END DO
RETURN
END SUBROUTINE gpbmap
......@@ -238,6 +238,7 @@ MODULE mpmod
INTEGER(mpi), DIMENSION(:), ALLOCATABLE :: globalIndexUsage !< indices of global par in record
INTEGER(mpi), DIMENSION(:), ALLOCATABLE :: backIndexUsage !< list of global par in record
INTEGER(mpi), DIMENSION(:), ALLOCATABLE :: appearanceCounter !< appearance statistics for global par (first/last file,record)
INTEGER(mpi), DIMENSION(:), ALLOCATABLE :: pairCounter !< number of paired parameters (in equations)
! local fit
REAL(mpd), DIMENSION(:), ALLOCATABLE::blvec !< local fit vector 'b' (in A*x=b), replaced by 'x'
REAL(mpd), DIMENSION(:), ALLOCATABLE::clmat !< local fit matrix 'A' (in A*x=b)
......
......@@ -639,6 +639,7 @@ PROGRAM mptwo
!$ WRITE(*,*) 'Maximum number of OpenMP threads: ', MXTHRD
!$ WRITE(*,*) 'Number of threads for processing: ', MTHRD
!$ IF (MXREC.GT.0) MTHRDR=1 ! to get allways the same MXREC records
!$ IF (ICHECK.GT.1) MTHRDR=1 ! to get allways the same order of records
!$ WRITE(*,*) 'Number of threads for reading: ', MTHRDR
!$POMP INST INIT ! start profiling with ompP
IF (ncache < 0) THEN
......@@ -2023,7 +2024,7 @@ SUBROUTINE peread(more)
ifd(k)=ifd(k-1)-kfd(1,k-1)
END DO
! sort
IF (nthr > 1) CALL sort2k(kfd,nfilb)
IF (nthr > 1) CALL sort2k(kfd,nfilb)
IF (skippedRecords > 0) THEN
PRINT *, 'PEREAD skipped records: ', skippedRecords
ndimbuf=maxRecordSize/2 ! adjust buffer size
......@@ -4184,9 +4185,9 @@ SUBROUTINE prtstat
IF (icheck > 1) THEN
WRITE(lup,*) '! '
WRITE(lup,*) '! Appearance statistics '
WRITE(lup,*) '! Label First file and record Last file and record number of files '
WRITE(lup,*) '! Label First file and record Last file and record #files #paired-par'
DO itgbi=1,ntgb
WRITE(lup,112) globalParLabelIndex(1,itgbi), (appearanceCounter(itgbi*5+k), k=-4,0)
WRITE(lup,112) globalParLabelIndex(1,itgbi), (appearanceCounter(itgbi*5+k), k=-4,0), pairCounter(itgbi)
END DO
END IF
REWIND lup
......@@ -4194,7 +4195,7 @@ SUBROUTINE prtstat
110 FORMAT(' ! ',i10,2X,2G14.5,2i12,' fixed',I2)
111 FORMAT(' ! ',i10,2X,2G14.5,2i12,' variable')
112 FORMAT(' ! ',i10,5i11)
112 FORMAT(' !.',i10,6i11)
END SUBROUTINE prtstat ! print input statistics
......@@ -5300,6 +5301,10 @@ SUBROUTINE loop2
INTEGER(mpi), DIMENSION(:), INTENT(OUT) :: nsparc
INTEGER(mpi), DIMENSION(:), INTENT(IN) :: ncmprs
END SUBROUTINE spbits
SUBROUTINE gpbmap(npair)
USE mpdef
INTEGER(mpi), DIMENSION(:), INTENT(OUT) :: npair
END SUBROUTINE gpbmap
END INTERFACE
SAVE
......@@ -5340,6 +5345,8 @@ SUBROUTINE loop2
! read all data files and add all variable index pairs -------------
IF (icheck > 1) CALL clbmap(ntgb)
IF(matsto == 2) THEN
CALL clbits(nagb,mreqpe,mhispe,msngpe,mcmprs,mextnd,ndimbi,nencdb,nspc) ! get dimension for bit storage, encoding, precision info
END IF
......@@ -5388,10 +5395,12 @@ SUBROUTINE loop2
! for checking appearance
IF (icheck > 1) THEN
print *, " checking appearance ", icheck, ntgb, nagb
length=5*ntgb
CALL mpalloc(appearanceCounter,length,'appearance statistics')
appearanceCounter=0
length=ntgb
CALL mpalloc(pairCounter,length,'pair statistics')
pairCounter=0
END IF
DO
......@@ -5473,6 +5482,10 @@ SUBROUTINE loop2
IF (appearanceCounter(joff+3) /= kfile) appearanceCounter(joff+5)=appearanceCounter(joff+5)+1
appearanceCounter(joff+3) = kfile
appearanceCounter(joff+4) = nrec-ifd(kfile) ! (local) record number
! count pairs
DO k=1,j
CALL inbmap(ij,inder(jb+k))
END DO
END IF
ij=globalParLabelIndex(2,ij) ! change to variable parameter
......@@ -5590,8 +5603,12 @@ SUBROUTINE loop2
END DO
! end=of=data=end=of=data=end=of=data=end=of=data=end=of=data=end=of
IF(matsto == 2) THEN
IF (icheck > 1) THEN
CALL gpbmap(pairCounter)
END IF
IF(matsto == 2) THEN
! constraints and index pairs with Lagrange multiplier
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment