Millepede-II V04-17-03
|
Millepede II program, subroutines. More...
Go to the source code of this file.
Functions/Subroutines | |
program | mptwo |
Millepede II main program Pede. More... | |
subroutine | solglo (ivgbi) |
Error for single global parameter from MINRES. More... | |
subroutine | solgloqlp (ivgbi) |
Error for single global parameter from MINRES-QLP. More... | |
subroutine | addcst |
Add constraint information to matrix and vector. More... | |
subroutine | grpcon |
Group constraints. More... | |
subroutine | prpcon |
Prepare constraints. More... | |
subroutine | feasma |
Matrix for feasible solution. More... | |
subroutine | feasib (concut, iact) |
Make parameters feasible. More... | |
subroutine | peread (more) |
Read (block of) records from binary files. More... | |
subroutine | peprep (mode) |
Prepare records. More... | |
subroutine | pechk (ibuf, nerr) |
Check Millepede record. More... | |
subroutine | pepgrp |
Parameter group info update. More... | |
subroutine | pargrp (inds, inde) |
Parameter group info update for block of parameters. More... | |
subroutine | isjajb (nst, is, ja, jb, jsp) |
Decode Millepede record. More... | |
subroutine | loopn |
Loop with fits and sums. More... | |
subroutine | ploopa (lunp) |
Print title for iteration. More... | |
subroutine | ploopb (lunp) |
Print iteration line. More... | |
subroutine | ploopc (lunp) |
Print sub-iteration line. More... | |
subroutine | ploopd (lunp) |
Print solution line. More... | |
subroutine | explfc (lunit) |
Print explanation of iteration table. More... | |
subroutine | mupdat (i, j, add) |
Update element of global matrix. More... | |
subroutine | mgupdt (i, j1, j2, il, jl, n, sub) |
Update global matrix for parameter group. More... | |
subroutine | loopbf (nrej, numfil, naccf, chi2f, ndff) |
Loop over records in read buffer (block), fits and sums. More... | |
subroutine | prtrej (lun) |
Print rejection statistics. More... | |
subroutine | prtglo |
Print final log file. More... | |
subroutine | prtstat |
Print input statistic. More... | |
subroutine | avprds (n, l, x, is, ie, b) |
Product symmetric (sub block) matrix times sparse vector. More... | |
subroutine | avprd0 (n, l, x, b) |
Product symmetric (sub block) matrix times vector. More... | |
subroutine | anasps |
Analyse sparsity structure. More... | |
subroutine | avprod (n, x, b) |
Product symmetric matrix times vector. More... | |
subroutine | ijpgrp (itema, itemb, ij, lr, iprc) |
Index (region length and precision) for sparse storage of parameter groups. More... | |
integer(mpi) function | ijprec (itema, itemb) |
Precision for storage of parameter groups. More... | |
integer(mpl) function | ijadd (itema, itemb) |
Index for sparse storage (custom). More... | |
integer(mpl) function | ijcsr3 (itema, itemb) |
Index for sparse storage (CSR3). More... | |
real(mpd) function | matij (itema, itemb) |
Get matrix element at (i,j). More... | |
subroutine | mhalf2 |
Fill 2nd half of matrix for extended storage. More... | |
subroutine | sechms (deltat, nhour, minut, secnd) |
Time conversion. More... | |
integer(mpi) function | inone (item) |
Translate labels to indices (for global parameters). More... | |
subroutine | upone |
Update, redefine hash indices. More... | |
subroutine | useone |
Make usable (sort items and redefine hash indices). More... | |
integer(mpi) function | iprime (n) |
largest prime number < N. More... | |
subroutine | loop1 |
First data loop (get global labels). More... | |
subroutine | loop1i |
Iteration of first data loop. More... | |
subroutine | loop2 |
Second data loop (number of derivatives, global label pairs). More... | |
subroutine | monres |
Monitor input residuals. More... | |
subroutine | vmprep (msize) |
Prepare storage for vectors and matrices. More... | |
subroutine | minver |
Solution by matrix inversion. More... | |
subroutine | mchdec |
Solution by Cholesky decomposition. More... | |
subroutine | mdptrf |
Solution by factorization. More... | |
subroutine | mdutrf |
Solution by factorization. More... | |
subroutine | lpqldec (a, emin, emax) |
QL decomposition. More... | |
subroutine | lpavat (t) |
Similarity transformation by Q(t). More... | |
subroutine | mspardiso |
Solution with Intel(R) oneAPI Math Kernel Library (oneMKL) PARDISO. More... | |
subroutine | mdiags |
Solution by diagonalization. More... | |
subroutine | zdiags |
Covariance matrix for diagonalization (,correction of eigenvectors). More... | |
subroutine | mminrs |
Solution with MINRES. More... | |
subroutine | mminrsqlp |
Solution with MINRES-QLP. More... | |
subroutine | mcsolv (n, x, y) |
Solution for zero band width preconditioner. More... | |
subroutine | mvsolv (n, x, y) |
Solution for finite band width preconditioner. More... | |
subroutine | xloopn |
Standard solution algorithm. More... | |
subroutine | chkrej |
Check rejection details. More... | |
subroutine | filetc |
Interprete command line option, steering file. More... | |
subroutine | filetx |
Interprete text files. More... | |
integer(mpi) function | nufile (fname) |
Inquire on file. More... | |
subroutine | intext (text, nline) |
Interprete text. More... | |
subroutine | additem (length, list, label, value) |
add item to list More... | |
subroutine | additemc (length, list, label, text) |
add character item to list More... | |
subroutine | additemi (length, list, label, ivalue) |
add item to list More... | |
subroutine | mstart (text) |
Start of 'module' printout. More... | |
subroutine | mend |
End of 'module' printout. More... | |
subroutine | mvopen (lun, fname) |
Open file. More... | |
subroutine | petime |
Print times. More... | |
subroutine | peend (icode, cmessage) |
Print exit code. More... | |
subroutine | binopn (kfile, ithr, ierr) |
Open binary file. More... | |
subroutine | bincls (kfile, ithr) |
Close binary file. More... | |
subroutine | binrwd (kfile) |
Rewind binary file. More... | |
subroutine | ckpgrp |
Check (rank of) parameter groups. More... | |
subroutine | chkmat |
Check global matrix. More... | |
subroutine | addsums (ithrd, chi2, ndf, dw) |
Accurate summation. More... | |
subroutine | getsums (chi2, ndf, wndf) |
Get accurate sums. More... | |
Millepede II program, subroutines.
Definition in file pede.f90.
subroutine addcst |
Add constraint information to matrix and vector.
Definition at line 1581 of file pede.f90.
References mpmod::globalparameter, mpmod::globalparlabelindex, mpmod::globalvector, mpmod::icalcm, mpmod::lenconstraints, mpmod::listconstraints, mpmod::matconssort, mupdat(), mpmod::nagb, mpmod::ncgb, mpmod::nvgb, mpmod::vecconsresiduals, and mpmod::vecconsstart.
Referenced by xloopn().
subroutine additem | ( | integer(mpi), intent(inout) | length, |
type(listitem), dimension(:), intent(inout), allocatable | list, | ||
integer(mpi), intent(in) | label, | ||
real(mpd), intent(in) | value | ||
) |
add item to list
[in,out] | length | length of list |
[in,out] | list | list of items |
[in] | label | item label |
[in] | value | item value |
Definition at line 12969 of file pede.f90.
References mpdef::mpl.
Referenced by intext().
subroutine additemc | ( | integer(mpi), intent(inout) | length, |
type(listitemc), dimension(:), intent(inout), allocatable | list, | ||
integer(mpi), intent(in) | label, | ||
character(len = itemclen), intent(in) | text | ||
) |
add character item to list
[in,out] | length | length of list |
[in,out] | list | list of items |
[in] | label | item label |
[in] | text | item text |
Definition at line 13011 of file pede.f90.
References mpdef::mpl.
Referenced by intext().
subroutine additemi | ( | integer(mpi), intent(inout) | length, |
type(listitemi), dimension(:), intent(inout), allocatable | list, | ||
integer(mpi), intent(in) | label, | ||
integer(mpi), intent(in) | ivalue | ||
) |
add item to list
[in,out] | length | length of list |
[in,out] | list | list of items |
[in] | label | item label |
[in] | ivalue | item value |
Definition at line 13053 of file pede.f90.
References mpdef::mpl.
Referenced by intext().
subroutine addsums | ( | integer(mpi), intent(in) | ithrd, |
real(mpd), intent(in) | chi2, | ||
integer(mpi), intent(in) | ndf, | ||
real(mpd), intent(in) | dw | ||
) |
Accurate summation.
Sum up Chi2 (integer part in integer, fractional part in double variable) and (weighted) NDF (per thread)
[in] | ithrd | thread index (1..MTHRD) |
[in] | chi2 | summand |
[in] | ndf | summand |
[in] | dw | weight (from binary file) |
Definition at line 13538 of file pede.f90.
References mpmod::globalchi2sumd, mpmod::globalchi2sumi, mpmod::globalndfsum, and mpmod::globalndfsumw.
subroutine anasps |
Analyse sparsity structure.
Definition at line 6176 of file pede.f90.
References mpmod::globalallindexgroups, mpmod::matsto, mpmod::napgrp, mpmod::nspc, mpmod::sparsematrixcolumns, and mpmod::sparsematrixoffsets.
Referenced by loop2().
subroutine avprd0 | ( | integer(mpi), intent(in) | n, |
integer(mpl), intent(in) | l, | ||
real(mpd), dimension(n), intent(in) | x, | ||
real(mpd), dimension(n), intent(out) | b | ||
) |
Product symmetric (sub block) matrix times vector.
A(sym) * X => B. Used by MINRES method (Is most CPU intensive part). The matrix A is the global matrix in full symmetric or (compressed) sparse storage. In full symmetric storage it could be block diagonal (MATSTO=3) and only a single block is used in the product.
[in] | n | size of (sub block) matrix |
[in] | l | offset of (sub block) parameter range |
[in] | x | vector X |
[out] | b | result vector B |
Definition at line 6008 of file pede.f90.
References mpmod::globalallindexgroups, mpmod::globalmatd, mpmod::globalmatf, mpmod::globalrowoffsets, mpmod::matsto, mpmod::mextnd, mpmod::mthrd, mpmod::napgrp, mpmod::nspc, peend(), mpmod::sparsematrixcolumns, and mpmod::sparsematrixoffsets.
Referenced by avprod(), mminrs(), and mminrsqlp().
subroutine avprds | ( | integer(mpi), intent(in) | n, |
integer(mpl), intent(in) | l, | ||
real(mpd), dimension(n), intent(in) | x, | ||
integer(mpi), intent(in) | is, | ||
integer(mpi), intent(in) | ie, | ||
real(mpd), dimension(n), intent(out) | b | ||
) |
Product symmetric (sub block) matrix times sparse vector.
A(sym) * X => B. (Cumultative). Used by MINRES method (Is most CPU intensive part). The matrix A is the global matrix in full symmetric or (compressed) sparse storage. In full symmetric storage it could be block diagonal (MATSTO=3) and only a single block is used in the product.
[in] | n | size of matrix |
[in] | l | offset of (sub block) parameter range |
[in] | x | vector X |
[in] | is | start of range x(is:ie) |
[in] | ie | end of range x(is:ie) |
[out] | b | result vector B |
Definition at line 5794 of file pede.f90.
References mpmod::globalallindexgroups, mpmod::globalmatd, mpmod::globalmatf, mpmod::globalrowoffsets, mpmod::matsto, mpmod::mextnd, mpmod::mthrd, mpmod::napgrp, mpmod::nspc, peend(), mpmod::sparsematrixcolumns, and mpmod::sparsematrixoffsets.
Referenced by mchdec(), mdiags(), mdptrf(), mdutrf(), minver(), mminrs(), mminrsqlp(), and xloopn().
subroutine avprod | ( | integer(mpi), intent(in) | n, |
real(mpd), dimension(n), intent(in) | x, | ||
real(mpd), dimension(n), intent(out) | b | ||
) |
Product symmetric matrix times vector.
A(sym) * X => B. Used by MINRES method (Is most CPU intensive part). The matrix A is the global matrix in full symmetric or (compressed) sparse storage. Allows for size of X and smaller than size of matrix in case of solution with constriants by elimination.
[in] | n | size of matrix ( <= size of global matrix) |
[in] | x | vector X |
[in] | b | result vector B |
Definition at line 6270 of file pede.f90.
References avprd0(), mpmod::nagb, peend(), qlmlq(), mpmod::vecbav, and mpmod::vecxav.
Referenced by mminrs(), mminrsqlp(), solglo(), and solgloqlp().
subroutine bincls | ( | integer(mpi), intent(in) | kfile, |
integer(mpi), intent(in) | ithr | ||
) |
subroutine binopn | ( | integer(mpi), intent(in) | kfile, |
integer(mpi), intent(in) | ithr, | ||
integer(mpi), intent(out) | ierr | ||
) |
Open binary file.
[in] | kfile | file number |
[in] | ithr | thread number ([1..nthrd] - close and reopen) or 0 (next file - keep open) for C files |
[out] | ierr | error flag |
Definition at line 13250 of file pede.f90.
References mpmod::nfilf, openc(), peend(), mpmod::sfd, mpmod::tfd, and mpmod::yfd.
subroutine binrwd | ( | integer(mpi), intent(in) | kfile | ) |
Rewind binary file.
[in] | kfile | file number |
Definition at line 13381 of file pede.f90.
References mpmod::nfilf, and resetc().
Referenced by peread().
subroutine chkmat |
Check global matrix.
Definition at line 13492 of file pede.f90.
References mpmod::globalmatd, mpmod::globalrowoffsets, mpmod::matsto, and mpmod::nagb.
subroutine chkrej |
Check rejection details.
Definition at line 11229 of file pede.f90.
References mpmod::jfd, mpmod::kfd, mpmod::nfilb, mpmod::nfilw, and mpmod::wfd.
Referenced by xloopn().
subroutine ckpgrp |
Check (rank of) parameter groups.
Definition at line 13412 of file pede.f90.
References mpmod::globalallindexgroups, mpmod::globalparlabelindex, mpmod::globalparvartototal, mpmod::ndefpg, mpmod::nvpgrp, and sqminv().
Referenced by loopn().
subroutine explfc | ( | integer(mpi) | lunit | ) |
Print explanation of iteration table.
Definition at line 4000 of file pede.f90.
References mpmod::metsol.
Referenced by mptwo().
subroutine feasib | ( | real(mps), intent(in) | concut, |
integer(mpi), intent(out) | iact | ||
) |
Make parameters feasible.
Correct for constraint equation discrepancies.
[in] | concut | cut for discrepancies |
[out] | iact | =1 if correction needed, else =0 |
Definition at line 2428 of file pede.f90.
References dbsvx(), mpmod::globalparameter, mpmod::globalparlabelindex, mpmod::globalparvartototal, mpmod::listconstraints, mpmod::matconsgroups, mpmod::matconsproduct, mpmod::matconssort, mpmod::ncgb, mpmod::ncgrp, mpmod::nvgb, mpmod::vecconsresiduals, mpmod::vecconssolution, and mpmod::vecconsstart.
Referenced by xloopn().
subroutine feasma |
Matrix for feasible solution.
Check rank of product matrix of constraints.
Definition at line 2253 of file pede.f90.
References mpmod::globalparameter, mpmod::globalparlabelindex, mpmod::globalparvartototal, mpmod::icelim, mpmod::icheck, mpmod::iforce, mpmod::isubit, mpmod::listconstraints, lpqldec(), mpmod::lunlog, mpmod::matconsblocks, mpmod::matconsgroups, mpmod::matconsproduct, mpmod::matconsranges, mpmod::matconssort, mpmod::matparblockoffsets, monend(), monini(), mpmod::monpg1, mpmod::monpg2, mpmod::mszcon, mpmod::mszprd, mpmod::ncgb, mpmod::ncgrp, mpmod::nfgb, mpmod::nmiss1, mpmod::npblck, mpmod::nvgb, peend(), qldecb(), qlgete(), qlini(), sqminv(), mpmod::vecconsresiduals, mpmod::vecconssolution, and mpmod::vecconsstart.
Referenced by loop2().
subroutine filetc |
Interprete command line option, steering file.
Fetch and interprete command line options, if steering file specified, check file existence (calling NUFILE)
If no steering file specified, check default steering file.
Create test files for command line option '-t'.
Read steering file, print some lines, detect names of text and binary files, check file existence, store all file names.
Open all binary files.
Definition at line 11293 of file pede.f90.
References bincls(), binopn(), mpmod::cfd, mpmod::dfd, mpmod::filnam, mpmod::icheck, mpmod::ictest, mpmod::ifd, mpmod::ifile, mpmod::iforce, initc(), intext(), mpmod::isubit, mpmod::jfd, mpmod::keepopen, mpmod::kfd, mpmod::lfd, mpmod::mdebug, mpmod::mfd, mpmod::mprint, mptest(), mptst2(), mstart(), mpmod::mthrdr, mpmod::nfd, mpmod::nfilb, mpmod::nfilc, mpmod::nfiles, mpmod::nfilf, mpmod::nfilw, mpmod::nfnam, mpmod::ofd, peend(), ratext(), rltext(), mpmod::sfd, mpmod::tfd, mpmod::times, mpmod::wfd, mpmod::xfd, and mpmod::yfd.
Referenced by mptwo().
subroutine filetx |
Interprete text files.
Reset flags and read steering and all other text files. Print some lines from each file.
Store parameter values, constraints and measurements.
Check flags METSOL (method of solution) and MATSTO (matrix storage mode). Set default values for flags, which are undefined.
Parameter values, format:
1 label 2 (initial) parameter value 3 pre-sigma 4 label 5 (initial) parameter value 6 pre-sigma 7 label ... ... (number of words is multiple of 3)
Constraint data, format:
1 -line_number ! constraint header of four words: 2 right-hand-side ! 0 and -1 ... 3 -1; -2 ! ... indicate (weighting) ... 4 sigma ! ... header 5 label 6 factor 7 label 8 factor 9 ... ... ... (number of words is multiple of 2, at least 6)
Measured data, format:
1 -line_number ! constraint header of four words: 2 right-hand-side ! 0 and -1 ... 3 -1 ! ... indicate ... 4 sigma ! ... header 5 label 6 factor 7 label 8 factor 9 ... ... ... (number of words is multiple of 2, at least 6)
Definition at line 11769 of file pede.f90.
References mpmod::chicut, mpmod::chirem, mpmod::dwcut, mpmod::filnam, intext(), mpmod::lfd, mpmod::lhuber, mpmod::lsearch, mpmod::lunkno, mpmod::matsto, mpmod::mbandw, mend(), mpmod::metsol, mpmod::mfd, mpmod::mitera, mpmod::mpdbsz, mpmod::mprint, mpmod::nfd, mpmod::nfiles, mpmod::nfnam, mpmod::nummeasurements, peend(), rltext(), and mpmod::tfd.
Referenced by mptwo().
subroutine getsums | ( | real(mpd), intent(out) | chi2, |
integer(mpl), intent(out) | ndf, | ||
real(mpd), intent(out) | wndf | ||
) |
Get accurate sums.
Integrated over threads.
[out] | chi2 | (accurate) chi2 sum |
[out] | ndf | ndf sum |
[out] | wndf | weighted ndf sum |
Definition at line 13571 of file pede.f90.
References mpmod::globalchi2sumd, mpmod::globalchi2sumi, mpmod::globalndfsum, and mpmod::globalndfsumw.
Referenced by loopn().
subroutine grpcon |
Group constraints.
Group constraints using all parameters (exploiting sparsity), resolve redundancy constraints.
Definition at line 1655 of file pede.f90.
References mpmod::globalparcons, mpmod::globalparlabelcounter, mpmod::globalparlabelindex, mpmod::icheck, mpmod::irslvrc, mpmod::lenconstraints, mpmod::listconstraints, mpmod::matconsgroups, mpmod::matconsranges, mpmod::matconssort, mpmod::ncgb, mpmod::ncgrp, mpmod::ntgb, sort1k(), sort2i(), and mpmod::vecconsstart.
Referenced by loop1().
integer(mpl) function ijadd | ( | integer(mpi), intent(in) | itema, |
integer(mpi), intent(in) | itemb | ||
) |
Index for sparse storage (custom).
In case of (compressed) sparse storage calculate index for off-diagonal matrix element.
[in] | itema | row number |
[in] | itemb | column number |
Definition at line 6437 of file pede.f90.
References mpmod::globalallindexgroups, mpmod::globalallpartogroup, ijadd(), ijpgrp(), and mpmod::nagb.
integer(mpl) function ijcsr3 | ( | integer(mpi), intent(in) | itema, |
integer(mpi), intent(in) | itemb | ||
) |
Index for sparse storage (CSR3).
In case of sparse storage calculate index for off-diagonal matrix element.
[in] | itema | row number |
[in] | itemb | column number |
Definition at line 6486 of file pede.f90.
References mpmod::csr3columnlist, mpmod::csr3rowoffsets, ijcsr3(), mpmod::nagb, and peend().
subroutine ijpgrp | ( | integer(mpi), intent(in) | itema, |
integer(mpi), intent(in) | itemb, | ||
integer(mpl), intent(out) | ij, | ||
integer(mpi), intent(out) | lr, | ||
integer(mpi), intent(out) | iprc | ||
) |
Index (region length and precision) for sparse storage of parameter groups.
Calculate index for parameter group block matrix (region of continous groups)
[in] | itema | row number |
[in] | itemb | column number |
[out] | ij | index of first element (>(<) 0: double(single) precision element, =0: not existing) |
[out] | lr | length of region (2nd row in group has index ij+lr) |
[out] | iprc | precision (1: REAL(mpd), 2: REAL(mps)) |
Definition at line 6310 of file pede.f90.
References mpmod::globalallindexgroups, mpmod::napgrp, mpmod::nspc, mpmod::sparsematrixcolumns, and mpmod::sparsematrixoffsets.
integer(mpi) function ijprec | ( | integer(mpi), intent(in) | itema, |
integer(mpi), intent(in) | itemb | ||
) |
Precision for storage of parameter groups.
[in] | itema | row number |
[in] | itemb | column number |
Definition at line 6408 of file pede.f90.
References ijpgrp(), ijprec(), mpmod::matsto, and mpmod::nspc.
Referenced by ijprec().
integer(mpi) function inone | ( | integer(mpi), intent(in) | item | ) |
Translate labels to indices (for global parameters).
Functions INONE and subroutine UPONE are used to collect items, i.e. labels, and to order and translate them.
In the first phase items are collected and stored by calling IRES=INONE(ITEM)
.
At the first entry the two sub-arrays "a" (globalParLabelIndex) and "b" (globalParHashTable) of length 2N are generated with a start length for N=128 entries. In array "a" two words are reserved for each item: (ITEM, count). The function INONE(ITEM) returns the number of the item. At each entry the argument is compared with the already stored items, new items are stored. Search for entries is done using hash-indices, stored in sub-array "b". The initial hash-index is
j = 1 + mod(ITEM, n_prime) + N
where n_prime is the largest prime number less than N. At each entry the count is increased by one. If N items are stored, the size of the sub-arrays is increased by calling CALL UPONE
.
[in] | item | label |
Definition at line 6734 of file pede.f90.
References mpmod::globalparhashtable, mpmod::globalparheader, mpmod::globalparlabelcounter, mpmod::globalparlabelindex, inone(), iprime(), mpmod::lunlog, mpmod::lvllog, and upone().
Referenced by inone().
subroutine intext | ( | character (len=*), intent(in) | text, |
integer(mpi), intent(in) | nline | ||
) |
Interprete text.
Look for keywords and argument in text line.
[in] | text | text |
[in] | nline | line number |
Definition at line 12092 of file pede.f90.
References additem(), additemc(), additemi(), mptext::keya, mptext::keyb, mptext::keyc, ratext(), and rltext().
integer(mpi) function iprime | ( | integer(mpi), intent(in) | n | ) |
largest prime number < N.
[in] | n | N |
Definition at line 6906 of file pede.f90.
References iprime(), mpdef::mpi, and mpdef::mps.
subroutine isjajb | ( | integer(mpi), intent(in) | nst, |
integer(mpi), intent(inout) | is, | ||
integer(mpi), intent(out) | ja, | ||
integer(mpi), intent(out) | jb, | ||
integer(mpi), intent(out) | jsp | ||
) |
Decode Millepede record.
Get indices JA, JB, IS for next measurement within record:
readBufferDataD(JA)
(readBufferDataI(JA+J),readBufferDataD(JA+J),J=1,JB-JA-1)
i.e. JB-JA-1 derivativesreadBufferDataD(JB)
(readBufferDataI(JB+J),readBufferDataD(JB+J),J=1,IS-JB)
i.e. IST-JB derivativesEnd_of_data is indicated by returned values JA=0 and JB=0 Special data are ignored. At end_of_data the info to the special data is returned: IS = pointer to special data; number of words is NSP=-readBufferDataD(IS)
.
[in] | nst | index of last word of record |
[in,out] | is | index of last global derivative (index of first word of record at the first call) |
[out] | ja | index of measured value (=0 at end), = pointer to local derivatives |
[out] | jb | index of standard deviation (=0 at end), = pointer to global derivatives |
[out] | jsp | index to special data |
Definition at line 3383 of file pede.f90.
References mpmod::readbufferdatad, and mpmod::readbufferdatai.
Referenced by loop1i(), loop2(), loopbf(), pepgrp(), and peprep().
subroutine loop1 |
First data loop (get global labels).
Read all data files and add all labels to global labels table, add labels from parameters, constraints and measurements (from text files).
Define variable and fixed global parameters (depending on entries and pre-sigma).
Iterate if records had been skipped due to too small read buffer size.
Definition at line 6938 of file pede.f90.
References mpmod::globalparameter, mpmod::globalparcomments, mpmod::globalparcons, mpmod::globalparcopy, mpmod::globalparheader, mpmod::globalparlabelcounter, mpmod::globalparlabelindex, mpmod::globalparpresigma, mpmod::globalparpreweight, mpmod::globalparstart, mpmod::globalparvartototal, mpmod::globaltotindexgroups, grpcon(), hmpdef(), hmpent(), hmpldf(), hmplnt(), hmprnt(), hmpwrt(), mpmod::iteren, mpmod::lencomments, mpmod::lenconstraints, mpmod::lenmeasurements, mpmod::lenparameters, mpmod::lenpresigmas, mpmod::listcomments, mpmod::listconstraints, mpmod::listmeasurements, mpmod::listparameters, mpmod::listpresigmas, loop1i(), mpmod::lunlog, mpmod::mcount, mend(), mpmod::metsol, mpmod::mprint, mpmod::mreqena, mpmod::mreqenf, mpmod::mreqpe, mpmod::msngpe, mstart(), mpmod::mthrdr, mpmod::ncache, mpmod::ndgb, mpmod::ndimbuf, mpmod::negb, mpmod::neqn, mpmod::nhistp, mpmod::npresg, mpmod::nrec, mpmod::nrecal, mpmod::nrecd, mpmod::nregul, mpmod::ntgb, mpmod::ntpgrp, mpmod::nvgb, mpmod::nvpgrp, mpmod::nzgb, peend(), pepgrp(), peprep(), peread(), mpmod::readbufferdatad, mpmod::readbufferdataf, mpmod::readbufferdatai, mpmod::readbufferpointer, mpmod::regpre, mpmod::regula, mpmod::skippedrecords, and upone().
Referenced by mptwo().
subroutine loop1i |
Iteration of first data loop.
Read all data files again skipping measurements with any parameter below the entries cut to update the number of entries.
Redefine variable and fixed global parameters (depending on updated entries).
Definition at line 7305 of file pede.f90.
References mpmod::globalparheader, mpmod::globalparlabelcounter, mpmod::globalparlabelindex, isjajb(), mpmod::iteren, mpmod::lunlog, mpmod::mreqenf, mpmod::mthrdr, mpmod::ncache, mpmod::ndimbuf, mpmod::ntgb, mpmod::numreadbuffer, mpmod::nvgb, peprep(), peread(), mpmod::readbufferdatad, mpmod::readbufferdataf, mpmod::readbufferdatai, and mpmod::readbufferpointer.
Referenced by loop1().
subroutine loop2 |
Second data loop (number of derivatives, global label pairs).
Calculate maximum number of local, global derivatives and equations per record.
For sparse storage count index pairs with bit (field) counters to construct sparsity structure (row offsets, (compressed) column lists).
Determine read/write cache splitting from average record values (length, global par. vector/matrix).
Check constraints for rank deficit.
Definition at line 7417 of file pede.f90.
References anasps(), mpmod::appearancecounter, mpmod::backindexusage, ckbits(), clbits(), clbmap(), mpmod::csr3columnlist, mpmod::csr3rowoffsets, mpmod::dflim, mpmod::fcache, feasma(), ggbmap(), mpmod::globalallindexgroups, mpmod::globalallpartogroup, mpmod::globalindexranges, mpmod::globalindexusage, mpmod::globalparcons, mpmod::globalparlabelindex, mpmod::globalparlabelzeros, mpmod::globalparvartototal, mpmod::globalrowoffsets, mpmod::globaltotindexgroups, gpbmap(), hmpdef(), hmprnt(), hmpwrt(), mpmod::icelim, mpmod::icheck, mpmod::ifd, mpmod::imonit, inbits(), inbmap(), mpmod::ipdbsz, irbits(), isjajb(), mpmod::lenmeasurements, mpmod::listconstraints, mpmod::listmeasurements, mpmod::localglobalmap, mpmod::localglobalmatrix, mpmod::localglobalstructure, mpmod::lunlog, mpmod::lunmon, mpmod::matbsz, mpmod::matconsblocks, mpmod::matconssort, mpmod::matmon, mpmod::matparblockoffsets, mpmod::matsto, mpmod::mbandw, mpmod::mcount, mpmod::mdebg2, mpmod::mdebug, mpmod::measbins, mpmod::meashists, mpmod::measindex, mpmod::measres, mend(), mpmod::metsol, mpmod::mextnd, mpmod::mhispe, mpmod::mitera, mpmod::mpdbsz, mpmod::mprint, mpmod::mreqpe, mpmod::mrestl, mpmod::msngpe, mstart(), mpmod::mthrd, mpmod::mthrdr, mvopen(), mpmod::mxrec, mpmod::naeqn, mpmod::nagb, mpmod::nagbn, mpmod::nalcn, mpmod::napgrp, mpmod::ncache, mpmod::ncblck, mpmod::ncgb, mpmod::ncgbe, mpmod::ncgrp, ndbits(), mpmod::ndimbuf, mpmod::nfgb, mpmod::nhistp, mpmod::npblck, mpmod::nprecond, mpmod::nrec, mpmod::nspc, mpmod::ntgb, mpmod::ntpgrp, mpmod::nummeas, mpmod::numreadbuffer, mpmod::nvgb, mpmod::nvpgrp, mpmod::nzgb, mpmod::paircounter, pblbits(), pbsbits(), pcbits(), peend(), peprep(), peread(), plbits(), prbits(), prpcon(), mpmod::readbufferdatad, mpmod::readbufferdataf, mpmod::readbufferdatai, mpmod::readbufferpointer, sort1k(), mpmod::sparsematrixcolumns, mpmod::sparsematrixoffsets, spbits(), mpmod::vecconsgroupcounts, mpmod::vecconsstart, mpmod::vecparblockconoffsets, vmprep(), mpmod::wolfc1, mpmod::wolfc2, mpmod::writebufferdata, mpmod::writebufferheader, mpmod::writebufferindices, mpmod::writebufferinfo, and mpmod::writebufferupdates.
Referenced by mptwo().
subroutine loopbf | ( | integer(mpl), dimension(6), intent(inout) | nrej, |
integer(mpi), intent(in) | numfil, | ||
integer(mpi), dimension(numfil), intent(inout) | naccf, | ||
real(mps), dimension(numfil), intent(inout) | chi2f, | ||
integer(mpi), dimension(numfil), intent(inout) | ndff | ||
) |
Loop over records in read buffer (block), fits and sums.
Loop over records in current read buffer block (with multiple threads). Perform local fits (optionally with outlier downweigthing) to calculate Chi2, ndf and r.h.s. 'b' of linear equation system A*x=b. In first iteration(s) fill global matrix A.
For the filling of the global matrix each thread creates from his share of local fits (small) udpdate matrices ( from equations (15), (16)) stored in a write buffer. After all events in the read buffer block have been processed the global matrix is being updated from the matrices in the write buffer in parallel (each row by different thread).
The matrices of the local fits are checked for bordered band structure. For border size b and band width m all elements (i,j) are zero for min(i,j)>b and abs(i-j)>m. For sufficient small (b,m) a solution by root free Cholesky decomposition and forward/backward substitution of the band part is much faster compared to inversion (see broken lines in references). Based on the expected computing cost the faster solution method is selected.
[in,out] | nrej | number of rejected records |
[in] | numfil | number of binary files |
[in,out] | naccf | number of accepted records per binary file |
[in,out] | chi2f | sum(chi2/ndf) per binary file |
[in,out] | ndff | sum(ndf) per binary file |
Definition at line 4344 of file pede.f90.
References addsums(), mpmod::aux, mpmod::backindexusage, mpmod::blvec, mpmod::chhuge, mpmod::chicut, mpmod::clmat, mpmod::cndlmx, dbavat(), dbavats(), mpmod::dwcut, mpmod::globalallindexgroups, mpmod::globalallpartogroup, mpmod::globalcounter, mpmod::globalindexusage, mpmod::globalparameter, mpmod::globalparlabelindex, mpmod::globalvector, gmpms(), hmpent(), mpmod::ibandh, mpmod::icalcm, mpmod::ifd, mpmod::imonit, mpmod::imonmd, isjajb(), mpmod::iterat, mpmod::lfitbb, mpmod::lfitnp, mpmod::lhuber, mpmod::localcorrections, mpmod::localequations, mpmod::localglobalmap, mpmod::localglobalmatrix, mpmod::localglobalstructure, mpmod::lunlog, mpmod::mdebug, mpmod::measbins, mpmod::measbinsize, mpmod::meashists, mpmod::measindex, mpmod::measres, mgupdt(), mpmod::monpg1, mpmod::mthrd, mpmod::naeqn, mpmod::nagb, mpmod::nagbn, mpmod::nbdrx, mpmod::nbndr, mpmod::nbndx, mpmod::newite, mpmod::nloopn, mpmod::nrec1, mpmod::nrec2, mpmod::nrec3, mpmod::nrecer, mpmod::nrecp2, mpmod::nrecpr, mpmod::nummeas, mpmod::numreadbuffer, mpmod::nvgb, peend(), mpmod::readbufferdatad, mpmod::readbufferdatai, mpmod::readbufferpointer, mpmod::scdiag, mpmod::scflag, sort1k(), sqmibb(), sqmibb2(), sqminv(), mpmod::value1, mpmod::value2, mpmod::vbdr, mpmod::vbk, mpmod::vbnd, mpmod::vzru, mpmod::writebufferdata, mpmod::writebufferheader, mpmod::writebufferindices, mpmod::writebufferinfo, and mpmod::writebufferupdates.
Referenced by loopn().
subroutine loopn |
Loop with fits and sums.
Loop over all binary files. Perform local fits to calculate Chi2, ndf and r.h.s. 'b' of linear equation system A*x=b. In first iteration(s) fill matrix A.
Definition at line 3434 of file pede.f90.
References mpmod::actfun, addsums(), mpmod::angras, mpmod::cfd, mpmod::chicut, mpmod::chirem, ckpgrp(), mpmod::delfun, mpmod::dfd, mpmod::flines, mpmod::fvalue, getsums(), mpmod::globalcounter, mpmod::globalmatd, mpmod::globalmatf, mpmod::globalparameter, mpmod::globalparlabelindex, mpmod::globalparpreweight, mpmod::globalparvartototal, mpmod::globalvector, gmpdef(), gmpwrt(), hmpdef(), hmpent(), hmpwrt(), mpmod::icalcm, mpmod::ichkpg, mpmod::iforce, mpmod::iitera, mpmod::imonit, mpmod::indprecond, mpmod::isubit, mpmod::iterat, mpmod::jfd, mpmod::lenglobalvec, mpmod::lenmeasurements, mpmod::lfitnp, mpmod::listmeasurements, loopbf(), mpmod::matprecond, mpmod::mbandw, mpmod::meashists, mpmod::metsol, monres(), mpmod::mreqena, mpmod::mthrd, mupdat(), mpmod::nalow, mpmod::nbdrx, mpmod::nbndr, mpmod::nbndx, mpmod::ndefec, mpmod::ndfsum, mpmod::newite, mpmod::nfgb, mpmod::nfilb, mpmod::nfiles, mpmod::nhistp, mpmod::nloopn, mpmod::nrec1, mpmod::nrec2, mpmod::nrec3, mpmod::nrecer, mpmod::nrecp2, mpmod::nrecpr, mpmod::nregul, mpmod::nrejec, mpmod::nvgb, mpmod::nxlow, peprep(), peread(), mpmod::prange, prtrej(), mpmod::sumndf, and mpmod::writebufferheader.
Referenced by xloopn().
subroutine lpavat | ( | logical, intent(in) | t | ) |
Similarity transformation by Q(t).
Similarity transformation for global matrix by Q from QL decomposition for unpacked storage using LAPACK.
Global matrix A is replaced by Q*A*Q^t (t=false) or Q^t*A*Q (t=true)
[in] | t | use transposed of Q |
Definition at line 9618 of file pede.f90.
References mpmod::globalmatd, mpmod::globalrowoffsets, mpmod::lapackql, mpmod::lapacktau, mpmod::lapackwork, mpmod::lplwrk, mpmod::matparblockoffsets, mpmod::npblck, and mpmod::vecparblockconoffsets.
subroutine lpqldec | ( | real(mpd), dimension(mszcon), intent(in) | a, |
real(mpd), intent(out) | emin, | ||
real(mpd), intent(out) | emax | ||
) |
QL decomposition.
QL decomposition of constraints matrix for solution by elimination for unpacked storage using LAPACK. Optionally split into disjoint blocks.
[in] | a | packed constraint matrix |
[out] | emin | eigenvalue with smallest absolute value |
[out] | emax | eigenvalue with largest absolute value |
Definition at line 9496 of file pede.f90.
References mpmod::lapackql, mpmod::lapacktau, mpmod::lapackwork, mpmod::lplwrk, mpmod::matconsblocks, mpmod::matconsranges, mpmod::matparblockoffsets, mpmod::ncgb, mpmod::npblck, and mpmod::vecparblockconoffsets.
Referenced by feasma().
real(mpd) function matij | ( | integer(mpi), intent(in) | itema, |
integer(mpi), intent(in) | itemb | ||
) |
Get matrix element at (i,j).
[in] | itema | row number |
[in] | itemb | column number |
Definition at line 6544 of file pede.f90.
References mpmod::globalmatd, mpmod::globalmatf, mpmod::globalrowoffsets, ijadd(), ijcsr3(), mpmod::matbsz, matij(), mpmod::matsto, and mpmod::nagb.
Referenced by matij().
subroutine mchdec |
Solution by Cholesky decomposition.
Parallelized (CHDEC2), solve A*x=b with A=LDL^t positive definite.
Definition at line 9056 of file pede.f90.
References avprds(), chdec2(), chslv2(), mpmod::globalcorrections, mpmod::globalmatd, mpmod::globalrowoffsets, mpmod::icalcm, mpmod::icelim, mpmod::iforce, mpmod::isubit, mpmod::lunlog, mpmod::matparblockoffsets, monend(), monini(), mpmod::monpg1, mpmod::monpg2, mpmod::ndefec, mpmod::nfgb, mpmod::npblck, mpmod::nvgb, qlbsub(), qlmlq(), qlsetb(), qlssq(), mpmod::vecconsresiduals, mpmod::vecconssolution, and mpmod::vecparblockconoffsets.
Referenced by xloopn().
subroutine mcsolv | ( | integer(mpi), intent(in) | n, |
real(mpd), dimension(n), intent(in) | x, | ||
real(mpd), dimension(n), intent(out) | y | ||
) |
Solution for zero band width preconditioner.
Used by MINRES.
[in] | n | size of vectors |
[in] | x | rhs vector |
[out] | y | result vector |
Definition at line 10334 of file pede.f90.
References mpmod::blockprecond, mpmod::matprecond, mpmod::mszpcc, mpmod::nprecond, mpmod::nvgb, and presols().
Referenced by mminrs(), mminrsqlp(), solglo(), and solgloqlp().
subroutine mdiags |
Solution by diagonalization.
Definition at line 9944 of file pede.f90.
References avprds(), devrot(), devsig(), devsol(), mpmod::globalcorrections, mpmod::globalmatd, mpmod::globalrowoffsets, mpmod::globalvector, gmpdef(), gmprnt(), gmpwrt(), gmpxy(), hmpdef(), hmpent(), hmprnt(), hmpwrt(), mpmod::icalcm, mpmod::lunlog, monend(), monini(), mpmod::monpg1, mpmod::monpg2, mpmod::nagb, mpmod::ncgb, mpmod::nfgb, mpmod::nhistp, mpmod::nvgb, qlbsub(), qlmlq(), qlssq(), mpmod::vecconsresiduals, mpmod::vecconssolution, mpmod::workspaced, mpmod::workspacediag, mpmod::workspacediagonalization, mpmod::workspaceeigenvalues, mpmod::workspaceeigenvectors, and mpmod::workspacei.
Referenced by xloopn().
subroutine mdptrf |
Solution by factorization.
Using LAPACK routines, packed storage (DyPTRF, DyPTRS) Solve A*x=b with A=LL^t positive definite (Cholesky, elimination) or with A=LDL^t indefinite (Bunch-Kaufman, Lagrange multipliers)
Definition at line 9168 of file pede.f90.
References avprds(), mpmod::globalcorrections, mpmod::globalmatd, mpmod::globalrowoffsets, mpmod::icalcm, mpmod::icelim, mpmod::ilperr, mpmod::lapackipiv, mpmod::lunlog, mpmod::matparblockoffsets, monend(), monini(), mpmod::monpg1, mpmod::monpg2, mpmod::nagb, mpmod::ndefec, mpmod::nfgb, mpmod::npblck, mpmod::nvgb, peend(), qlbsub(), qlmlq(), qlsetb(), qlssq(), mpmod::vecconsresiduals, mpmod::vecconssolution, mpmod::vecparblockconoffsets, and mpmod::workspacediag.
Referenced by xloopn().
subroutine mdutrf |
Solution by factorization.
Using LAPACK routines, unpacked storage (DPOTRF/DSYTRF, DPOTRS/DSYTRS) Solve A*x=b with A=LL^t positive definite (Cholesky, elimination) or with A=LDL^t indefinite (Bunch-Kaufman, Lagrange multipliers)
Definition at line 9315 of file pede.f90.
References avprds(), mpmod::globalcorrections, mpmod::globalmatd, mpmod::globalrowoffsets, mpmod::icalcm, mpmod::icelim, mpmod::ilperr, mpmod::lapackipiv, mpmod::lapackql, mpmod::lapacktau, mpmod::lapackwork, lpavat(), mpmod::lplwrk, mpmod::lunlog, mpmod::matparblockoffsets, monend(), monini(), mpmod::monpg1, mpmod::monpg2, mpmod::nagb, mpmod::ndefec, mpmod::nfgb, mpmod::npblck, mpmod::nvgb, peend(), qlbsub(), qlmlq(), qlsetb(), qlssq(), mpmod::vecconsresiduals, mpmod::vecconssolution, mpmod::vecparblockconoffsets, and mpmod::workspacediag.
Referenced by xloopn().
subroutine mend |
subroutine mgupdt | ( | integer(mpi), intent(in) | i, |
integer(mpi), intent(in) | j1, | ||
integer(mpi), intent(in) | j2, | ||
integer(mpi), intent(in) | il, | ||
integer(mpi), intent(in) | jl, | ||
integer(mpi), intent(in) | n, | ||
real(mpd), dimension((n*n+n)/2), intent(in) | sub | ||
) |
Update global matrix for parameter group.
Add values -SUB to matrix elements (continous block in smaller index) .
[in] | i | larger index |
[in] | j1 | smaller index first group |
[in] | j2 | smaller index last group |
[in] | il | subtrahends first row |
[in] | jl | subtrahends first col |
[in] | n | size of (symmetric) subtrahends matrix |
[in] | sub | subtrahends matrix ('small', number of elements fits in 'mpi') |
Definition at line 4176 of file pede.f90.
References mpmod::csr3rowoffsets, mpmod::globalallindexgroups, mpmod::globalmatd, mpmod::globalmatf, mpmod::globalrowoffsets, ijpgrp(), mpmod::matbsz, and mpmod::matsto.
Referenced by loopbf().
subroutine mhalf2 |
Fill 2nd half of matrix for extended storage.
Definition at line 6602 of file pede.f90.
References mpmod::globalallindexgroups, mpmod::globalmatd, mpmod::globalmatf, mpmod::mthrd, mpmod::napgrp, mpmod::nspc, mpmod::sparsematrixcolumns, and mpmod::sparsematrixoffsets.
Referenced by xloopn().
subroutine minver |
Solution by matrix inversion.
Parallelized (SQMINL), solve A*x=b.
Definition at line 8943 of file pede.f90.
References avprds(), dbsvxl(), mpmod::globalcorrections, mpmod::globalmatd, mpmod::globalrowoffsets, mpmod::icalcm, mpmod::icelim, mpmod::iforce, mpmod::isubit, mpmod::lunlog, mpmod::matparblockoffsets, monend(), monini(), mpmod::monpg1, mpmod::monpg2, mpmod::nagb, mpmod::ndefec, mpmod::nfgb, mpmod::npblck, mpmod::nvgb, qlbsub(), qlmlq(), qlsetb(), qlssq(), sqminl(), mpmod::vecconsresiduals, mpmod::vecconssolution, mpmod::vecparblockconoffsets, mpmod::workspaced, mpmod::workspacediag, mpmod::workspacei, and mpmod::workspacerow.
Referenced by xloopn().
subroutine mminrs |
Solution with MINRES.
Solve A*x=b by minimizing |A*x-b| iteratively. Parallelized (AVPROD).
Use preconditioner with zero (precon) or finite (equdec) band width.
Definition at line 10130 of file pede.f90.
References avprd0(), avprds(), avprod(), mpmod::blockprecond, equdecs(), mpmod::globalcorrections, mpmod::icalcm, mpmod::iitera, mpmod::indprecond, mpmod::istopa, mpmod::lprecm, mpmod::lunlog, mpmod::matprecond, mpmod::mbandw, mcsolv(), minresmodule::minres(), mpmod::mnrsit, monend(), monini(), mpmod::monpg1, mpmod::monpg2, mpmod::mrestl, mpmod::mszpcc, mvsolv(), mpmod::nagb, mpmod::ncgb, mpmod::nfgb, mpmod::nprecond, mpmod::nvgb, precons(), qlbsub(), qlmlq(), qlpssq(), mpmod::vecbav, mpmod::vecconsresiduals, mpmod::vecconssolution, mpmod::vecxav, and mpmod::workspaced.
Referenced by xloopn().
subroutine mminrsqlp |
Solution with MINRES-QLP.
Solve A*x=b by minimizing |A*x-b| iteratively. Parallelized (AVPROD).
Use preconditioner with zero (precon) or finite (equdec) band width.
Definition at line 10228 of file pede.f90.
References avprd0(), avprds(), avprod(), mpmod::blockprecond, equdecs(), mpmod::globalcorrections, mpmod::icalcm, mpmod::iitera, mpmod::indprecond, mpmod::istopa, mpmod::lprecm, mpmod::lunlog, mpmod::matprecond, mpmod::mbandw, mcsolv(), minresqlpmodule::minresqlp(), mpmod::mnrsit, monend(), monini(), mpmod::monpg1, mpmod::monpg2, mpmod::mrestl, mpmod::mrmode, mpmod::mrtcnd, mpmod::mszpcc, mvsolv(), mpmod::nagb, mpmod::ncgb, mpmod::nfgb, mpmod::nprecond, mpmod::nvgb, precons(), qlbsub(), qlmlq(), qlpssq(), mpmod::vecbav, mpmod::vecconsresiduals, mpmod::vecconssolution, mpmod::vecxav, and mpmod::workspaced.
Referenced by xloopn().
subroutine monres |
Monitor input residuals.
Read all data files again to monitor input residuals
Definition at line 8639 of file pede.f90.
References mpmod::globalparlabelindex, mpmod::imonmd, mpmod::lunmon, mpmod::measbins, mpmod::measbinsize, mpmod::meashists, mpmod::measindex, mpmod::measres, mpmod::mthrd, mpmod::nloopn, mpmod::ntgb, and mpmod::nummeas.
program mptwo |
Millepede II main program Pede.
Definition at line 910 of file pede.f90.
References mpmod::cfd, mpmod::chicut, mpmod::chirem, mpmod::cpostproc, mptest1::del, mpmod::dfd, mptest1::dvd, mpmod::dwcut, explfc(), filetc(), filetx(), mpmod::globalchi2sumd, mpmod::globalchi2sumi, mpmod::globalmatd, mpmod::globalndfsum, mpmod::globalndfsumw, mpmod::globalparameter, mpmod::globalparlabelindex, gmpdef(), gmplun(), gmprnt(), gmpwrt(), gmpxy(), hmpdef(), hmpent(), hmplun(), hmprnt(), hmpwrt(), mpmod::icheck, mpmod::ictest, mpmod::ipdmem, mpmod::iteren, mpmod::jfd, mpmod::kfd, mpmod::lenpostproc, mpmod::lfitnp, mpmod::lhuber, loop1(), loop2(), mpmod::lunlog, mpmod::lunmon, mpmod::lvllog, mpdalc::maxwordsalloc, mpmod::memdbg, mpmod::metsol, mpmod::mnrsit, mpmod::mprint, mpmod::mreqenf, mstart(), mpmod::mthrd, mpmod::mthrdr, mvopen(), mpmod::ncache, mpmod::ncgbe, mpmod::nfilb, mpmod::nhistp, mpmod::nloopn, mptest2::nlyr, mptest2::nmx, mptest2::nmy, mptest1::nplan, mpmod::nrec1, mpmod::nrec2, mpmod::nrec3, mpmod::nrecp2, mpmod::nrecpr, mpmod::nrejec, mptest2::ntot, peend(), mpdalc::printflagalloc, prtrej(), prtstat(), mpmod::readbufferinfo, mptest2::sdevx, mptest2::sdevy, sechms(), mpmod::times, mpmod::value1, mpmod::value2, and xloopn().
subroutine mspardiso |
Solution with Intel(R) oneAPI Math Kernel Library (oneMKL) PARDISO.
Sparse matrix
Definition at line 9715 of file pede.f90.
References mpmod::csr3columnlist, mpmod::csr3rowoffsets, mpmod::globalcorrections, mpmod::globalmatd, mpmod::icalcm, mpmod::ipddbg, mpmod::ipdmem, mpmod::lenpardiso, mpmod::listpardiso, mpmod::lunlog, mpmod::matbsz, monend(), monini(), mpmod::monpg1, mpmod::monpg2, mpmod::nfgb, mpmod::nvgb, and peend().
Referenced by xloopn().
subroutine mstart | ( | character (len=*), intent(in) | text | ) |
subroutine mupdat | ( | integer(mpi), intent(in) | i, |
integer(mpi), intent(in) | j, | ||
real(mpd), intent(in) | add | ||
) |
Update element of global matrix.
Add value ADD to matrix element (I,J).
[in] | i | first index |
[in] | j | second index |
[in] | add | summand |
Definition at line 4091 of file pede.f90.
References mpmod::globalmatd, mpmod::globalmatf, mpmod::globalrowoffsets, mpmod::indprecond, mpmod::matbsz, mpmod::matprecond, mpmod::matsto, mpmod::mbandw, mpmod::metsol, mpmod::nvgb, mpmod::offprecond, and peend().
subroutine mvopen | ( | integer(mpi), intent(in) | lun, |
character (len=*), intent(in) | fname | ||
) |
subroutine mvsolv | ( | integer(mpi), intent(in) | n, |
real(mpd), dimension(n), intent(in) | x, | ||
real(mpd), dimension(n), intent(out) | y | ||
) |
Solution for finite band width preconditioner.
Used by MINRES.
[in] | n | size of vectors |
[in] | x | rhs vector |
[out] | y | result vector |
Definition at line 10355 of file pede.f90.
References mpmod::blockprecond, equslvs(), mpmod::indprecond, mpmod::matprecond, mpmod::mszpcc, and mpmod::nprecond.
Referenced by mminrs(), mminrsqlp(), solglo(), and solgloqlp().
integer(mpi) function nufile | ( | character (len=*), intent(inout) | fname | ) |
Inquire on file.
Result = 1 for existing binary file, =2 for existing text file, else =0, < 0 open error.
Text file names are recognized by the filename extension, which should contain 'xt' or 'tx'.
[in,out] | fname | file name, optionaly strip prefix. |
Definition at line 12035 of file pede.f90.
References matint(), and nufile().
Referenced by nufile().
subroutine pargrp | ( | integer(mpi), intent(in) | inds, |
integer(mpi), intent(in) | inde | ||
) |
Parameter group info update for block of parameters.
Build and split groups (defined by common first parameter).
[in] | inds | index of first parmeters in read buffer |
[in] | inde | index of last parmeters in read buffer |
Definition at line 3266 of file pede.f90.
References mpmod::globalparheader, mpmod::globalparlabelcounter, mpmod::globalparlabelindex, and mpmod::readbufferdatai.
Referenced by pepgrp().
subroutine pechk | ( | integer(mpi), intent(in) | ibuf, |
integer(mpi), intent(out) | nerr | ||
) |
Check Millepede record.
Check integer structure of labels and markers (zeros). Check floats for NaNs.
[in] | ibuf | buffer number |
[out] | nerr | error flags |
Definition at line 3040 of file pede.f90.
References mpmod::readbufferdatad, mpmod::readbufferdatai, and mpmod::readbufferpointer.
Referenced by peprep().
subroutine peend | ( | integer(mpi), intent(in) | icode, |
character (len=*), intent(in) | cmessage | ||
) |
Print exit code.
Print exit code and message.
[in] | icode | exit code |
[in] | cmessage | exit massage |
Definition at line 13229 of file pede.f90.
References mvopen().
Referenced by avprd0(), avprds(), avprod(), binopn(), devrot(), feasma(), filetc(), filetx(), ijcsr3(), loop1(), loop2(), loopbf(), mdptrf(), mdutrf(), mpdalc::mpalloccheck(), mpdalc::mpdealloccheck(), mptwo(), mspardiso(), mupdat(), mvopen(), peprep(), peread(), sort1k(), sort22l(), sort2i(), sort2k(), vmprep(), and xloopn().
subroutine pepgrp |
Parameter group info update.
Group parameters on level of equations or records (counting in addition).
Definition at line 3112 of file pede.f90.
References mpmod::backindexusage, mpmod::globalparheader, isjajb(), mpmod::mcount, mpmod::mthrd, mpmod::numreadbuffer, mpmod::nzgb, pargrp(), mpmod::readbufferdatad, mpmod::readbufferdatai, mpmod::readbufferpointer, sort1k(), and useone().
Referenced by loop1().
subroutine peprep | ( | integer(mpi), intent(in) | mode | ) |
Prepare records.
For global parameters replace label by index (INONE
).
[in] | mode | <=0: build index table (INONE) for global variables; >0: use index table, can be parallelized, optional scale errors |
Definition at line 2939 of file pede.f90.
References mpmod::dscerr, mpmod::iscerr, isjajb(), mpmod::mthrd, mpmod::ndgb, mpmod::negb, mpmod::neqn, mpmod::numreadbuffer, pechk(), peend(), mpmod::readbufferdatad, mpmod::readbufferdatai, and mpmod::readbufferpointer.
subroutine peread | ( | integer(mpi), intent(out) | more | ) |
Read (block of) records from binary files.
Optionally using several threads (each file read by single thread). Records larger than the read buffer (ndimbuf
) are skipped. In case of skipped events in the first loop over all binary files the buffer size is adapted to the maximum record size (and the initial loop (LOOP1
) is repeated). C binary files are handled by readc.c and may be gzipped.
[out] | more | more records to come |
The records consist of parallel integer and real arrays:
real array integer array 1 0.0 error count (this record) 2 RMEAS, measured value 0 JA 3 local derivative index of local derivative 4 local derivative index of local derivative 5 ... 6 SIGMA, error (>0) 0 JB global derivative label of global derivative global derivative label of global derivative IST RMEAS, measured value 0 local derivative index of local derivative local derivative index of local derivative ... SIGMA, error 0 global derivative label of global derivative global derivative label of global derivative ... NR global derivative label of global derivative
Definition at line 2589 of file pede.f90.
References bincls(), binopn(), binrwd(), hmpent(), hmplnt(), mpmod::icheck, mpmod::ifd, mpmod::ifile, mpmod::ireeof, mpmod::keepopen, mpmod::kfd, mpmod::lunlog, mpmod::maxrecordsinblock, mpmod::minrecordsinblock, mpmod::mprint, mpmod::mthrdr, mpmod::mxrec, mpmod::ncache, mpmod::ndimbuf, mpmod::nfilb, mpmod::nfilf, mpmod::nfilw, mpmod::nloopn, mpmod::nrderr, mpmod::nrec, mpmod::nrecd, mpmod::numblocks, mpmod::numreadbuffer, peend(), mpmod::readbufferdatad, mpmod::readbufferdataf, mpmod::readbufferdatai, mpmod::readbufferinfo, mpmod::readbufferpointer, readc(), mpmod::skippedrecords, sort2k(), mpmod::sumrecords, mpmod::wfd, and mpmod::xfd.
subroutine petime |
Print times.
Print the elapsed and total time.
Definition at line 13178 of file pede.f90.
References mpdef::mpi.
Referenced by mend().
subroutine ploopa | ( | integer(mpi), intent(in) | lunp | ) |
subroutine ploopb | ( | integer(mpi), intent(in) | lunp | ) |
Print iteration line.
[in] | lunp | unit number |
Definition at line 3869 of file pede.f90.
References mpmod::angras, mpmod::chicut, mpmod::delfun, mpmod::deltim, mpmod::fvalue, mpmod::iitera, mpmod::istopa, mpmod::iterat, mpmod::lcalcm, mpmod::lsinfo, mpmod::nloopn, mpmod::nrejec, ptlopt(), mpmod::rstart, sechms(), and mpmod::stepl.
Referenced by xloopn().
subroutine ploopc | ( | integer(mpi), intent(in) | lunp | ) |
Print sub-iteration line.
[in] | lunp | unit number |
Definition at line 3926 of file pede.f90.
References mpmod::deltim, mpmod::fvalue, mpmod::lcalcm, mpmod::lsinfo, mpmod::nloopn, mpmod::nrejec, ptlopt(), mpmod::rstart, sechms(), and mpmod::stepl.
Referenced by xloopn().
subroutine ploopd | ( | integer(mpi), intent(in) | lunp | ) |
Print solution line.
[in] | lunp | unit number |
Definition at line 3974 of file pede.f90.
References mpmod::deltim, mpmod::lcalcm, mpmod::rstart, and sechms().
Referenced by xloopn().
subroutine prpcon |
Prepare constraints.
Check constraints, combine groups into non overlapping blocks.
Definition at line 1953 of file pede.f90.
References mpmod::globalindexranges, mpmod::globalparcons, mpmod::globalparlabelindex, mpmod::icheck, mpmod::iskpec, mpmod::lenconstraints, mpmod::listconstraints, mpmod::matconsblocks, mpmod::matconsgroups, mpmod::matconsranges, mpmod::matconssort, mpmod::mszcon, mpmod::mszprd, mpmod::ncblck, mpmod::ncgb, mpmod::ncgbe, mpmod::ncgrp, mpmod::ntgb, and mpmod::vecconsstart.
Referenced by loop2().
subroutine prtglo |
Print final log file.
For each global parameter:
Definition at line 5416 of file pede.f90.
References mpmod::globalcounter, mpmod::globalmatd, mpmod::globalparameter, mpmod::globalparcomments, mpmod::globalparlabelcounter, mpmod::globalparlabelindex, mpmod::globalparlabelzeros, mpmod::globalparpresigma, mpmod::globalparstart, mpmod::globalparvartototal, mpmod::globalrowoffsets, mpmod::igcorr, mpmod::ipcntr, mpmod::listcomments, mpmod::metsol, mpmod::mreqena, mvopen(), mpmod::nagb, mpmod::ntgb, mpmod::nvgb, mpmod::workspacediag, mpmod::workspaceeigenvalues, and mpmod::workspaceeigenvectors.
subroutine prtrej | ( | integer(mpi), intent(in) | lun | ) |
subroutine prtstat |
Print input statistic.
For each global parameter:
Definition at line 5603 of file pede.f90.
References mpmod::appearancecounter, ggbmap(), mpmod::globalparameter, mpmod::globalparcomments, mpmod::globalparcons, mpmod::globalparlabelcounter, mpmod::globalparlabelindex, mpmod::globalparlabelzeros, mpmod::globalparpresigma, mpmod::globalparvartototal, mpmod::globaltotindexgroups, mpmod::icheck, mpmod::ipcntr, mpmod::listcomments, mpmod::matconsgroups, mvopen(), mpmod::ncgrp, mpmod::ntgb, mpmod::ntpgrp, mpmod::paircounter, and mpmod::vecconsgroupcounts.
Referenced by mptwo().
subroutine sechms | ( | real(mps), intent(in) | deltat, |
integer(mpi), intent(out) | nhour, | ||
integer(mpi), intent(out) | minut, | ||
real(mps), intent(out) | secnd | ||
) |
subroutine solglo | ( | integer(mpi), intent(in) | ivgbi | ) |
Error for single global parameter from MINRES.
Calculate single row 'x_i' from inverse matrix by solving A*x_i=b with b=0 except b_i=1.
[in] | ivgbi | index of variable parameter |
Definition at line 1414 of file pede.f90.
References avprod(), mpmod::globalcorrections, mpmod::globalparameter, mpmod::globalparlabelindex, mpmod::globalparpresigma, mpmod::globalparstart, mpmod::globalparvartototal, mpmod::globalvector, mpmod::mbandw, mcsolv(), minresmodule::minres(), mpmod::mrestl, mvsolv(), and mpmod::nagb.
Referenced by xloopn().
subroutine solgloqlp | ( | integer(mpi), intent(in) | ivgbi | ) |
Error for single global parameter from MINRES-QLP.
Calculate single row 'x_i' from inverse matrix by solving A*x_i=b with b=0 except b_i=1.
[in] | ivgbi | index of variable parameter |
Definition at line 1498 of file pede.f90.
References avprod(), mpmod::globalcorrections, mpmod::globalparameter, mpmod::globalparlabelindex, mpmod::globalparpresigma, mpmod::globalparstart, mpmod::globalparvartototal, mpmod::globalvector, mpmod::mbandw, mcsolv(), minresqlpmodule::minresqlp(), mpmod::mrestl, mpmod::mrmode, mpmod::mrtcnd, mvsolv(), and mpmod::nagb.
Referenced by xloopn().
subroutine upone |
Update, redefine hash indices.
Definition at line 6804 of file pede.f90.
References mpmod::globalparhashtable, mpmod::globalparheader, mpmod::globalparlabelcounter, mpmod::globalparlabelindex, mpmod::lunlog, mpmod::lvllog, and sort22l().
subroutine useone |
Make usable (sort items and redefine hash indices).
Definition at line 6874 of file pede.f90.
References mpmod::globalparhashtable, mpmod::globalparheader, mpmod::globalparlabelcounter, mpmod::globalparlabelindex, and sort22l().
Referenced by pepgrp().
subroutine vmprep | ( | integer(mpl), dimension(2), intent(in) | msize | ) |
Prepare storage for vectors and matrices.
[in] | msize | number of words for storage of global matrix (double, single prec.) |
Definition at line 8746 of file pede.f90.
References mpmod::aux, mpmod::blockprecond, mpmod::blvec, mpmod::clmat, mpmod::globalcorrections, mpmod::globalcounter, mpmod::globalmatd, mpmod::globalmatf, mpmod::globalvector, mpmod::ibandh, mpmod::icelim, mpmod::ilperr, mpmod::indprecond, mpmod::lapackipiv, mpmod::lapackwork, mpmod::lenglobalvec, mpmod::localcorrections, mpmod::localequations, mpmod::lplwrk, mpmod::matconsblocks, mpmod::matparblockoffsets, mpmod::matprecond, mpmod::mbandw, mpmod::metsol, mpmod::mszpcc, mpmod::mthrd, mpmod::naeqn, mpmod::nagb, mpmod::nalcn, mpmod::ncblck, mpmod::nfgb, mpmod::npblck, mpmod::nvgb, mpmod::offprecond, peend(), mpmod::scdiag, mpmod::scflag, mpmod::vbdr, mpmod::vbk, mpmod::vbnd, mpmod::vecbav, mpmod::vecparblockconoffsets, mpmod::vecxav, mpmod::vzru, mpmod::workspaced, mpmod::workspacediag, mpmod::workspacediagonalization, mpmod::workspaceeigenvalues, mpmod::workspaceeigenvectors, mpmod::workspacei, mpmod::workspacelinesearch, and mpmod::workspacerow.
Referenced by loop2().
subroutine xloopn |
Standard solution algorithm.
Iterative solution. In current iteration calculate:
ICALCM = +1 Matrix, gradient, Function value & solution ICALCM = 0 gradient, Function value ICALCM = -1 solution ICALCM = -2 end
Solution is obtained by selected method and improved by line search.
Definition at line 10388 of file pede.f90.
References addcst(), mpmod::angras, avprds(), mpmod::chicut, mpmod::chirem, chkrej(), mpmod::delfun, mpmod::deltim, mpmod::dflim, mpmod::dscerr, mpmod::dwcut, feasib(), mpmod::flines, mpmod::fvalue, mpmod::globalcorrections, mpmod::globalmatd, mpmod::globalparameter, mpmod::globalparcopy, mpmod::globalparlabelindex, mpmod::globalparvartototal, mpmod::globalrowoffsets, mpmod::globalvector, gmpxy(), gmpxyd(), mpmod::icalcm, mpmod::icelim, mpmod::iitera, mpmod::ilperr, mpmod::imonit, mpmod::ipcntr, mpmod::iscerr, mpmod::isubit, mpmod::iterat, mpmod::lapackipiv, mpmod::lbmnrs, mpmod::lcalcm, mpmod::lhuber, loopn(), lpavat(), mpmod::lprecm, mpmod::lsearch, mpmod::lsinfo, mpmod::lunlog, mpmod::lunmon, mpmod::matbsz, mpmod::matparblockoffsets, mpmod::matrit, mpmod::matsto, mpmod::mbandw, mchdec(), mdiags(), mdptrf(), mdutrf(), mend(), mpmod::metsol, mpmod::mextnd, mhalf2(), minver(), mpmod::mitera, mminrs(), mminrsqlp(), mpmod::mnrsel, monend(), monini(), mpmod::monpg1, mpmod::monpg2, monres(), mpmod::mrmode, mpmod::mrtcnd, mspardiso(), mpmod::nagb, mpmod::nalow, mpmod::ncgbe, mpmod::ndefec, mpmod::ndefpg, mpmod::ndfsum, mpmod::nfgb, mpmod::nfilw, mpmod::nloopn, mpmod::nmiss1, mpmod::nofeas, mpmod::npblck, mpmod::npresg, mpmod::nrderr, mpmod::nrecal, mpmod::nregul, mpmod::nrejec, mpmod::nvgb, mpmod::nxlow, peend(), ploopa(), ploopb(), ploopc(), ploopd(), prtglo(), prtrej(), ptldef(), ptline(), ptlprt(), qlssq(), mpmod::regpre, mpmod::regula, mpmod::rstart, solglo(), solgloqlp(), mpmod::stepl, mpmod::sumndf, mpmod::times, mpmod::vecparblockconoffsets, mpmod::wolfc2, mpmod::workspaced, mpmod::workspacediag, mpmod::workspacelinesearch, and zdiags().
Referenced by mptwo().
subroutine zdiags |
Covariance matrix for diagonalization (,correction of eigenvectors).
Definition at line 10093 of file pede.f90.
References devinv(), mpmod::globalmatd, mpmod::nfgb, mpmod::nvgb, qlmlq(), mpmod::workspaceeigenvalues, and mpmod::workspaceeigenvectors.
Referenced by xloopn().