subroutine init_LAstats c ***----------------------------------------------------------*** c * 'init_LAstats' initializes all entries of the 'counts' * c * array in common block LAstats to zero. * c ***----------------------------------------------------------*** integer mx_num_mesh, mx_num_fails parameter (mx_num_mesh = 25, mx_num_fails = 10) real counts(mx_num_mesh,5) integer fails(mx_num_mesh,mx_num_fails) common /LAstats/ counts, fails c integer k, j c do 20 k = 1, mx_num_mesh counts(k,1) = 0. counts(k,2) = 0. counts(k,3) = 0. counts(k,4) = 0. counts(k,5) = 0. fails(k,1) = 0 do 10 j = 1, mx_num_fails fails(k,j) = 0 10 continue 20 continue return end c subroutine update_LAstats (solver, array, nrwblk, nbloks, * nparts, work, call_type) c double precision array(1), work(1) integer nrwblk, nbloks, nparts, call_type character*3 solver c ***----------------------------------------------------------*** c * 'update_LAstats' updates the statistics for linear * c * systems built on a mesh of 'nbloks' subintervals. * c * See subroutine 'display_LAstats' for details on which * c * statistics are recorded. 'call_type' is used to start * c * the timer or identify what has just been timed: * c * * c * call_type = 0 => start the timer * c * call_type = 1 => a factorization/solve pair * c * call_type > 1 => a subsequent solve * c * * c * (This routine properly maintains `total_time'.) * c ***----------------------------------------------------------*** integer mx_num_mesh, mx_num_fails parameter (mx_num_mesh = 25, mx_num_fails = 10) real counts(mx_num_mesh,5) integer fails(mx_num_mesh,mx_num_fails) common /LAstats/ counts, fails c real total_time common /TOTALstats/ total_time c real elapsed_time, tarray(2), dtime, float integer k c if (call_type .eq. 0) then c ***----------------------------------------------------------*** c * Start timing this program segment, or, more precisely, * c * stop timing `total_time', update `total_time', and start * c * timing this program segment. * c ***----------------------------------------------------------*** elapsed_time = dtime(tarray) total_time = total_time + elapsed_time return else c ***----------------------------------------------------------*** c * Stop timing this program segment. Update and resume * c * timing `total_time'. * c ***----------------------------------------------------------*** elapsed_time = dtime(tarray) total_time = total_time + elapsed_time c ***----------------------------------------------------------*** c * Record statistics for this program segment. Note that * c * unstable factorization detection has been disabled in * c * this version of the LAstats package. * c ***----------------------------------------------------------*** do 20 k = 1, mx_num_mesh if (counts(k,1) .eq. float(nbloks)) then c ***----------------------------------------------------------*** c * Statistics have been recorded already for a mesh with * c * nbloks subintervals, so this call is likely coming * c * after a subsequent solve. However, it could also be * c * coming after a factorization/solve pair for a system * c * built on a redistributed mesh, or a system rebuilt on * c * the same mesh with an updated Jacobian after taking a * c * full-Newton step. * c ***----------------------------------------------------------*** if (call_type .eq. 1) then c ***----------------------------------------------------------*** c * A factorization/solve pair. * c ***----------------------------------------------------------*** counts(k,2) = counts(k,2) + 1. counts(k,3) = counts(k,3) + elapsed_time else c ***----------------------------------------------------------*** c * A subsequent solve. * c ***----------------------------------------------------------*** counts(k,4) = counts(k,4) + 1. counts(k,5) = counts(k,5) + elapsed_time end if return else if (counts(k,1) .eq. 0.0) then c ***----------------------------------------------------------*** c * Statistics for a mesh with nbloks subintervals have * c * not yet been recorded. This first call must be coming * c * after a factorization/solve pair. * c ***----------------------------------------------------------*** counts(k,1) = float(nbloks) counts(k,2) = 1. counts(k,3) = elapsed_time counts(k,4) = 0. counts(k,5) = 0. return end if 20 continue write(6,*) ' *** LAstats: counts/fails overflow! ' stop end if end c subroutine display_LAstats c ***----------------------------------------------------------*** c * 'display_LAstats' prints a summary of the statistics * c * collected in the LAstats common block. The k-th row of * c * of 'counts' and 'fails' contains the following data for * c * systems built on a mesh of counts(k,1) subintervals: * c * * c * counts(k,2) - # of factorizations * c * counts(k,3) - total factorization time * c * counts(k,4) - # of solves * c * counts(k,5) - total solve time * c * fails(k,1) - # of unstable factorizations * c * fails(k,2:fails(k,1)+1) - occurrence # for * c * each unstable factorization * c * * c * Note that the total factorization time includes the time * c * for counts(k,2) solves, since factorization/solve pairs * c * are being timed. This solve time is subtracted from the * c * total factorization time and added to the total solve * c * time before output. The total number of solves is also * c * adjusted accordingly before output. * c * * c * (Note also that unstable factorization detection has * c * been disabled in this version of the LAstats package.) * c ***----------------------------------------------------------*** integer mx_num_mesh, mx_num_fails parameter (mx_num_mesh = 25, mx_num_fails = 10) real counts(mx_num_mesh,5) integer fails(mx_num_mesh,mx_num_fails) common /LAstats/ counts, fails c integer j, k, nint, mesh_size, num_facts, num_solves, * total_facts, total_solves, total_unstable real time_per_solve, fact_time, solve_time, * total_fact_time, total_solve_time c write(6,9997) total_facts = 0 total_fact_time = 0. total_solves = 0 total_solve_time = 0. total_unstable = 0 do 10 k = 1, mx_num_mesh if (counts(k,1) .eq. 0.) go to 20 c ***----------------------------------------------------------*** c * Extract statistics from counts array. * c ***----------------------------------------------------------*** mesh_size = nint(counts(k,1)) num_facts = nint(counts(k,2)) num_solves = nint(counts(k,4) + counts(k,2)) time_per_solve = counts(k,5)/counts(k,4) fact_time = counts(k,3) - num_facts*time_per_solve solve_time = counts(k,5) + num_facts*time_per_solve c ***----------------------------------------------------------*** c * Output statistics for this mesh size. * c ***----------------------------------------------------------*** write(6,9999) mesh_size, num_facts, fact_time, * num_solves, solve_time c ***----------------------------------------------------------*** c * Accumulate totals. * c ***----------------------------------------------------------*** total_facts = total_facts + num_facts total_fact_time = total_fact_time + fact_time total_solves = total_solves + num_solves total_solve_time = total_solve_time + solve_time total_unstable = total_unstable + fails(k,1) 10 continue c ***----------------------------------------------------------*** c * Output totals. * c ***----------------------------------------------------------*** 20 write(6,9996) total_facts, total_fact_time, * total_solves, total_solve_time write(6,9994) total_fact_time + total_solve_time c ***----------------------------------------------------------*** c * Output occurrences of unstable factorizations. * c ***----------------------------------------------------------*** if (total_unstable .eq. 0) then write(6,9992) else write(6,9991) total_unstable do 30 k = 1, mx_num_mesh if (counts(k,1) .eq. 0.) then write(6,9979) return end if if (fails(k,1) .gt. 0) then mesh_size = nint(counts(k,1)) write(6,9990) mesh_size, * (fails(k,j),j=2,fails(k,1)+1) end if 30 continue end if return 9999 format (1x, i5, 3x, i4, 2x, e9.2, 2x, i4, 2x, e9.2) 9997 format (/1x, ' MIRKDC LINEAR ALGEBRA STATISTICS: ' * /1x, ' ---------------------------------------' * /1x, ' MESH', 2x, ' #FACTs', 2x, ' TIME', * 2x, ' #SOLVEs', 2x, ' TIME' * /1x, ' ---------------------------------------') 9996 format ( 1x, ' ---------------------------------------' * /1x, ' Total: ', i4, 2x, e9.2, 2x, i4, 2x, e9.2) 9994 format ( 1x, ' ---------------------------------------' * /1x, ' Total monitored LA time: ', f6.2, ' secs.') 9992 format (/1x, ' (Unstable factorization detection is disabled.)') 9991 format (/1x, ' WARNING - Unstable factorizations were' * /1x, ' detected as follows (', i2, ' in total):' * /1x, ' ---------------------------------------' * /1x, ' MESH', 2x, ' AT OCCURRENCE(S)' * /1x, ' ---------------------------------------') 9990 format (1x, i5, 4x, 10(1x, i2)) 9979 format ( 1x, ' ---------------------------------------') end