Commit 3994ecf4 authored by Claus Kleinwort's avatar Claus Kleinwort
Browse files

Monitoring of progress improved

git-svn-id: http://svnsrv.desy.de/public/MillepedeII/trunk@202 3547b9b0-65b8-46d3-b95d-921b3f43af62
parent a763dab2
......@@ -84,7 +84,7 @@ L_FLAGS = -Wall -O3
#
# objects for this project
#
USER_OBJ_PEDE = mpdef.o mpdalc.o mpmod.o mpbits.o mpqldec.o mptest1.o mptest2.o mille.o mpnum.o mptext.o mphistab.o \
USER_OBJ_PEDE = mpdef.o mpdalc.o mpmod.o mpmon.o mpbits.o mpqldec.o mptest1.o mptest2.o mille.o mpnum.o mptext.o mphistab.o \
minresDataModule.o minresModule.o minresqlpDataModule.o minresqlpBlasModule.o minresqlpModule.o \
randoms.o vertpr.o linesrch.o Dbandmatrix.o pede.o
#
......
......@@ -54,7 +54,7 @@ L_FLAGS = -O3
#
# objects for this project
#
USER_OBJ_PEDE = mpdef.o mpdalc.o mpmod.o mpbits.o mpqldec.o mptest1.o mptest2.o mille.o mpnum.o mptext.o mphistab.o \
USER_OBJ_PEDE = mpdef.o mpdalc.o mpmod.o mpmon.o mpbits.o mpqldec.o mptest1.o mptest2.o mille.o mpnum.o mptext.o mphistab.o \
minresDataModule.o minresModule.o minresqlpDataModule.o minresqlpBlasModule.o minresqlpModule.o \
randoms.o vertpr.o linesrch.o Dbandmatrix.o pede.o
#
......
......@@ -109,7 +109,9 @@ MODULE mpmod
REAL(mpd), DIMENSION(2) :: dscerr = (/ 1.0, 1.0 /) !< scaling factors for errors of 'global' and 'local' measurement
INTEGER(mpi) :: keepOpen=1 !< flag for keeping binary files open
INTEGER(mpi) :: ireeof=0 !< flag for treating (binary file) read errors as end-of-file
INTEGER(mpi) :: mcount=0 !< flag for grouping and counying global parameters on equlation (0) or record (1) level
INTEGER(mpi) :: mcount=0 !< flag for grouping and counting global parameters on equlation (0) or record (1) level
INTEGER(mpi) :: monpg1=0 !< progress monitoring, repetition rate start value
INTEGER(mpi) :: monpg2=0 !< progress monitoring, repetition rate max increase
! variables
INTEGER(mpi) :: lunmon !< unit for monitoring output file
......
!> \file
!! Progress monitoring.
!!
!! \author Claus Kleinwort, DESY, 2020 (Claus.Kleinwort@desy.de)
!!
!! \copyright
!! Copyright (c) 2020 Deutsches Elektronen-Synchroton,
!! Member of the Helmholtz Association, (DESY), HAMBURG, GERMANY \n\n
!! This library is free software; you can redistribute it and/or modify
!! it under the terms of the GNU Library General Public License as
!! published by the Free Software Foundation; either version 2 of the
!! License, or (at your option) any later version. \n\n
!! This library is distributed in the hope that it will be useful,
!! but WITHOUT ANY WARRANTY; without even the implied warranty of
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
!! GNU Library General Public License for more details. \n\n
!! You should have received a copy of the GNU Library General Public
!! License along with this program (see the file COPYING.LIB for more
!! details); if not, write to the Free Software Foundation, Inc.,
!! 675 Mass Ave, Cambridge, MA 02139, USA.
!!
!! Monitor progress in routines taking significant amount of cpu time.
!!
!> Monitoring data.
MODULE mpmonpgs
USE mpdef
IMPLICIT NONE
INTEGER(mpi) :: lun !< output unit
INTEGER(mpi) :: nrep !< repetition rate
INTEGER(mpi) :: nrepmi !< repetition rate max increase
END MODULE mpmonpgs
!> Initialize monitoring.
!!
!! \param [in] l output unit
!! \param [in] n1 repetition rate start value
!! \param [in] n2 repetition rate max increase
!!
SUBROUTINE monini(l,n1,n2)
USE mpmonpgs
IMPLICIT NONE
INTEGER(mpi), INTENT(IN) :: l
INTEGER(mpi), INTENT(IN) :: n1
INTEGER(mpi), INTENT(IN) :: n2
CHARACTER (LEN=24) :: chdate
lun=l
nrep=n1
nrepmi=n2
CALL fdate(chdate)
WRITE(lun,*) ' Starting - ', chdate
END SUBROUTINE monini
!> Progress monitoring.
!!
!! \param [in] i index
!!
!! If index >= nrep print index and update nrep -> nrep + min(nrep,nrepmi)
!!
SUBROUTINE monpgs(i)
USE mpmonpgs
IMPLICIT NONE
INTEGER(mpi), INTENT(IN) :: i
IF (i >= nrep) THEN
WRITE(lun,*) ' Index: ', i
nrep=nrep+min(nrep,nrepmi)
END IF
END SUBROUTINE monpgs
!> End monitoring.
SUBROUTINE monend()
USE mpmonpgs
IMPLICIT NONE
CHARACTER (LEN=24) :: chdate
CALL fdate(chdate)
WRITE(lun,*) ' Ending - ', chdate
END SUBROUTINE monend
......@@ -224,8 +224,9 @@ END SUBROUTINE sqminv
!! \param [out] DIAG double precision scratch array
!! \param [out] NEXT integer aux array
!! \param [out] VK double precision scratch array (pivot)
!! \param [in] MON flag for progress monitoring
SUBROUTINE sqminl(v,b,n,nrank,diag,next,vk) !
SUBROUTINE sqminl(v,b,n,nrank,diag,next,vk,mon) !
USE mpdef
IMPLICIT NONE
......@@ -243,6 +244,7 @@ SUBROUTINE sqminl(v,b,n,nrank,diag,next,vk) !
REAL(mpd), INTENT(OUT) :: diag(n)
INTEGER(mpi), INTENT(OUT) :: next(n)
REAL(mpd), INTENT(OUT) :: vk(n)
INTEGER(mpi), INTENT(IN) :: mon
INTEGER(mpl) :: i8
INTEGER(mpl) :: j8
......@@ -269,6 +271,8 @@ SUBROUTINE sqminl(v,b,n,nrank,diag,next,vk) !
nrank=0
DO i=1,n ! start of loop
! monitoring ?
IF(mon>0) CALL monpgs(i)
k =0
vkk=0.0_mpd
j=next0
......@@ -881,8 +885,9 @@ END SUBROUTINE cholin
!! \param [out] NRANK rank of matrix g
!! \param [out] EVMAX largest element in D
!! \param [out] EVMIN smallest element in D
!! \param [in] MON flag for progress monitoring
!!
SUBROUTINE chdec2(g,n,nrank,evmax,evmin)
SUBROUTINE chdec2(g,n,nrank,evmax,evmin,mon)
USE mpdef
IMPLICIT NONE
......@@ -898,10 +903,13 @@ SUBROUTINE chdec2(g,n,nrank,evmax,evmin)
INTEGER(mpi), INTENT(OUT) :: nrank
REAL(mpd), INTENT(OUT) :: evmin
REAL(mpd), INTENT(OUT) :: evmax
INTEGER(mpi), INTENT(IN) :: mon
nrank=0
ii=(INT(n,mpl)*INT(n+1,mpl))/2
DO i=n,1,-1
! monitoring ?
IF(mon>0) CALL monpgs(n+1-i)
IF (g(ii) > 0.0_mpd) THEN
! update rank, min, max eigenvalue
nrank=nrank+1
......
......@@ -32,6 +32,7 @@ MODULE mpqldec
INTEGER(mpi) :: ncon !< number of constraints
INTEGER(mpi) :: nblock !< number of blocks
INTEGER(mpi) :: iblock !< active block
INTEGER(mpi) :: monpg !< flag for progress monitoring
INTEGER(mpi), DIMENSION(:), ALLOCATABLE :: sparseV !< sparsity structure matV
REAL(mpd), DIMENSION(:), ALLOCATABLE :: matV !< unit normals (v_i) of Householder reflectors
REAL(mpd), DIMENSION(:), ALLOCATABLE :: matL !< lower diagonal matrix L
......@@ -46,8 +47,9 @@ END MODULE mpqldec
!! \param [in] n number of rows (parameters)
!! \param [in] m number of columns (constraints)
!! \param [in] l number of disjoint blocks
!! \param [in] k flag for progress monitoring
!!
SUBROUTINE qlini(n,m,l)
SUBROUTINE qlini(n,m,l,k)
USE mpqldec
USE mpdalc
......@@ -57,11 +59,13 @@ SUBROUTINE qlini(n,m,l)
INTEGER(mpi), INTENT(IN) :: n
INTEGER(mpi), INTENT(IN) :: m
INTEGER(mpi), INTENT(IN) :: l
INTEGER(mpi), INTENT(IN) :: k
npar=n
ncon=m
nblock=l
iblock=1
monpg=k
! allocate
length=5*ncon
CALL mpalloc(sparseV,length,'QLDEC: sparsity structure of V')
......@@ -127,6 +131,8 @@ SUBROUTINE qldec(a)
! Householder procedure
DO k=ncon,1,-1
! monitoring
IF(monpg>0) CALL monpgs(ncon+1-k)
kn=npar+k-ncon
! column offset
ioff1=(k-1)*npar
......@@ -251,6 +257,8 @@ SUBROUTINE qldecb(a,bpar,bcon)
k1=bcon(1,ibcon) ! first constraint in block
! Householder procedure
DO k=iclast,icoff+1,-1
! monitoring
IF(monpg>0) CALL monpgs(ncon+1-k)
kn=iplast+k-iclast
! different constraint block?
IF (k < k1) THEN
......@@ -442,6 +450,8 @@ SUBROUTINE qlsmq(x,t)
LOGICAL, INTENT(IN) :: t
DO j=1,ncon
! monitoring
IF(monpg>0) CALL monpgs(j)
k=j
IF (t) k=ncon+1-j
kn=npar+k-ncon
......@@ -523,6 +533,8 @@ SUBROUTINE qlssq(aprod,A,t)
nparb=nparBlock(ibpar) ! number of parameters in block
DO j=1,nconb
k=j
! monitoring
IF(monpg>0) CALL monpgs(icoff+k)
IF (t) k=nconb+1-j
kn=nparb+k-nconb
! column offset
......@@ -628,6 +640,8 @@ SUBROUTINE qlpssq(aprod,B,m,t)
DO j=1,ncon
k=j
! monitoring
IF(monpg>0) CALL monpgs(k)
IF (t) k=ncon+1-j
kn=npar+k-ncon
! column offset
......
......@@ -51,7 +51,7 @@
!! 1. Download the software package from the DESY \c svn server to
!! \a target directory, e.g.:
!!
!! svn checkout http://svnsrv.desy.de/public/MillepedeII/tags/V04-08-01 target
!! svn checkout http://svnsrv.desy.de/public/MillepedeII/tags/V04-08-02 target
!!
!! 2. Create **Pede** executable (in \a target directory):
!!
......@@ -128,6 +128,8 @@
!! This is enabled with the new command \ref cmd-countrecords and makes the iteration
!! of the first data loop (by \ref cmd-iterateentries) obsolete.
!! * 201027: New solution method \ref ch-mchdec "decomposition" implemented.
!! * 201214: New command \ref cmd-monpgs to monitor progress in operations
!! on global and constraints matrices.
!!
!! \section tools_sec Tools
!! The subdirectory \c tools contains some useful scripts:
......@@ -478,6 +480,12 @@
!! Set flag \ref mpmod::imonit "imonit" for monitoring of pulls to \a number1 [3]
!! and increase number of bins (of size 0.1) for internal storage to \a number2 [100].
!! Monitoring mode \ref mpmod::imonmd "imonmd" is 1.
!! \subsection cmd-monpgs monitorprogress
!! For progress monitoring set for repetition rate \c nrep the start value \ref mpmod::monpg1 "monpg1"
!! to \a number1 [1] and maximum increase \ref mpmod::monpg2 "monpg2" to \a number2 [1024].
!! Monitored are operations (inversion, decomposition, similarity) on the global and the constraints matrices.
!! If the (outermost loop) index is greater equal \c nrep the index is printed and \c nrep updated
!! (+ min(\c nrep, \c monpg2)).
!! \subsection cmd-mresmode mresmode
!! Set \ref minresqlpmodule::minresqlp "MINRES-QLP" factorization mode
!! \ref mpmod::mrmode "mrmode" to \a number1.
......@@ -1585,9 +1593,15 @@ SUBROUTINE feasma
print *
print *, 'QL decomposition of constraints matrix'
! QL decomposition
CALL qlini(nvgb,ncgb,npblck)
CALL qlini(nvgb,ncgb,npblck,monpg1)
! loop over parameter blocks
! monitor progress
IF(monpg1 > 0) THEN
WRITE(lunlog,*) 'QL decomposition of constraints matrix'
CALL monini(lunlog,monpg1,monpg2)
END IF
CALL qldecb(matConstraintsT,matParBlockOffsets,matConsBlocks)
IF(monpg1 > 0) CALL monend()
!CALL qldump()
! check eignevalues of L
CALL qlgete(evmin,evmax)
......@@ -3623,7 +3637,7 @@ SUBROUTINE loopbf(nrej,ndfs,sndf,dchi2s, numfil,naccf,chi2f,ndff)
!$OMP localCorrections,localEquations, &
!$OMP NAGB,NVGB,NAGBN,ICALCM,ICHUNK,NLOOPN,NRECER,NPRDBG,IPRDBG, &
!$OMP NEWITE,CHICUT,LHUBER,CHUBER,ITERAT,NRECPR,MTHRD,NSPC,NAEQN, &
!$OMP DWCUT,CHHUGE,NRECP2,CAUCHY,LFITNP,LFITBB,IMONIT,IMONMD) &
!$OMP DWCUT,CHHUGE,NRECP2,CAUCHY,LFITNP,LFITBB,IMONIT,IMONMD,MONPG1,LUNLOG) &
!$OMP REDUCTION(+:NDFS,SNDF,DCHI2S,NREJ,NBNDR,NACCF,CHI2F,NDFF) &
!$OMP REDUCTION(MAX:NBNDX,NBDRX) &
!$OMP REDUCTION(MIN:NREC3) &
......@@ -3648,6 +3662,7 @@ SUBROUTINE loopbf(nrej,ndfs,sndf,dchi2s, numfil,naccf,chi2f,ndff)
REC=nrc ! floating point value
IF(nloopn == 1.AND.MOD(nrc,100000) == 0) THEN
WRITE(*,*) 'Record',nrc,' ... still reading'
IF(monpg1>0) WRITE(lunlog,*) 'Record',nrc,' ... still reading'
END IF
! printout/debug only for one thread at a time
......@@ -7450,7 +7465,6 @@ SUBROUTINE minver
SAVE
! ...
lun=lunlog ! log file
IF(lunlog == 0) lunlog=6
IF(icalcm == 1) THEN
! save diagonal (for global correlation)
......@@ -7463,8 +7477,16 @@ SUBROUTINE minver
workspaceDiag(i+ipoff)=globalMatD((ii*ii+ii)/2+imoff) ! save diagonal elements
END DO
END DO
! use elimination for constraints ?
IF(nfgb < nvgb) CALL qlssq(avprd0,globalMatD,.true.) ! Q^t*A*Q
! use elimination for constraints ?
IF(nfgb < nvgb) THEN
! monitor progress
IF(monpg1 > 0) THEN
WRITE(lunlog,*) 'Shrinkage of global matrix (A->Q^t*A*Q)'
CALL monini(lunlog,monpg1,monpg2)
END IF
CALL qlssq(avprd0,globalMatD,.true.) ! Q^t*A*Q
IF(monpg1 > 0) CALL monend()
END IF
END IF
! loop over blocks
......@@ -7507,9 +7529,15 @@ SUBROUTINE minver
END IF
IF(icalcm == 1) THEN
! monitor progress
IF(monpg1 > 0) THEN
WRITE(lunlog,*) 'Inversion of global matrix (A->A^-1)'
CALL monini(lunlog,monpg1,monpg2)
END IF
! invert and solve
CALL sqminl(globalMatD(imoff+1:), globalCorrections(ipoff+1:),nfit,nrank, &
workspaceD,workspaceI,workspaceRow)
workspaceD,workspaceI,workspaceRow,monpg1)
IF(monpg1 > 0) CALL monend()
IF(nfit /= nrank) THEN
WRITE(*,*) 'Warning: the rank defect of the symmetric',nfit, &
'-by-',nfit,' matrix is ',nfit-nrank,' (should be zero).'
......@@ -7575,11 +7603,16 @@ SUBROUTINE mchdec
SAVE
! ...
lun=lunlog ! log file
IF(lunlog == 0) lunlog=6
IF(icalcm == 1) THEN
! use elimination for constraints ?
! monitor progress
IF(monpg1 > 0) THEN
WRITE(lunlog,*) 'Shrinkage of global matrix (A->Q^t*A*Q)'
CALL monini(lunlog,monpg1,monpg2)
END IF
IF(nfgb < nvgb) CALL qlssq(avprd0,globalMatD,.true.) ! Q^t*A*Q
IF(monpg1 > 0) CALL monend()
END IF
! loop over blocks
......@@ -7622,8 +7655,14 @@ SUBROUTINE mchdec
END IF
IF(icalcm == 1) THEN
! monitor progress
IF(monpg1 > 0) THEN
WRITE(lunlog,*) 'Decomposition of global matrix (A->L*D*L^t)'
CALL monini(lunlog,monpg1,monpg2)
END IF
! decompose and solve
CALL chdec2(globalMatD(imoff+1:),nfit,nrank,evmax,evmin)
CALL chdec2(globalMatD(imoff+1:),nfit,nrank,evmax,evmin,monpg1)
IF(monpg1 > 0) CALL monend()
IF(nfit /= nrank) THEN
WRITE(*,*) 'Warning: the rank defect of the symmetric',nfit, &
'-by-',nfit,' matrix is ',nfit-nrank,' (should be zero).'
......@@ -7683,7 +7722,6 @@ SUBROUTINE mdiags
! ...
lun=lunlog ! log file
IF(lunlog == 0) lun=6
! save diagonal (for global correlation)
IF(icalcm == 1) THEN
......@@ -7864,7 +7902,6 @@ SUBROUTINE mminrs
SAVE
! ...
lun=lunlog ! log file
IF(lunlog == 0) lun=6
nout=lun
itnlim=2000 ! iteration limit
......@@ -7953,7 +7990,6 @@ SUBROUTINE mminrsqlp
SAVE
! ...
lun=lunlog ! log file
IF(lunlog == 0) lun=6
nout=lun
itnlim=2000 ! iteration limit
......@@ -8151,7 +8187,6 @@ SUBROUTINE xloopn !
! Printout of algorithm for solution and important parameters ------
lun=lunlog ! log file
IF(lunlog == 0) lunlog=6
DO lunp=6,lunlog,lunlog-6
WRITE(lunp,*) ' '
......@@ -8303,6 +8338,11 @@ SUBROUTINE xloopn !
WRITE(*,*) ' '
WRITE(*,*)'Reading files and accumulating vectors/matrices ...'
WRITE(*,*) ' '
IF(monpg1>0) THEN
WRITE(lunlog,*)
WRITE(lunlog,*)'Reading files and accumulating vectors/matrices ...'
WRITE(lunlog,*)
END IF
rstart=etime(ta)
iterat=-1
......@@ -8569,7 +8609,13 @@ SUBROUTINE xloopn !
globalMatD(ioff+1:ioff+i)=0.0_mpd
END DO
END DO
CALL qlssq(avprd0,globalMatD,.false.) ! Q^t*A*Q
! monitor progress
IF(monpg1 > 0) THEN
WRITE(lunlog,*) 'Expansion of global matrix (A->Q*A*Q^t)'
CALL monini(lunlog,monpg1,monpg2)
END IF
CALL qlssq(avprd0,globalMatD,.false.) ! Q*A*Q^t
IF(monpg1 > 0) CALL monend()
END IF
END IF
......@@ -9893,6 +9939,16 @@ SUBROUTINE intext(text,nline)
RETURN
END IF
keystx='monitorprogress'
mat=matint(text(keya:keyb),keystx,npat,ntext) ! comparison
IF(100*mat >= 80*max(npat,ntext)) THEN ! 80% (symmetric) matching
monpg1=1
monpg2=1024
IF (nums > 0) monpg1=max(1,NINT(dnum(1),mpi))
IF (nums > 1) monpg2=max(1,NINT(dnum(2),mpi))
RETURN
END IF
keystx='scaleerrors'
mat=matint(text(keya:keyb),keystx,npat,ntext) ! comparison
IF(100*mat >= 80*max(npat,ntext)) THEN ! 80% (symmetric) matching
......
Supports Markdown
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