zlr_stats.F

Go to the documentation of this file.

C
C  This file is part of MUMPS 5.5.1, released
C  on Tue Jul 12 13:17:24 UTC 2022
C
C
C  Copyright 1991-2022 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
C  Mumps Technologies, University of Bordeaux.
C
C  This version of MUMPS is provided to you free of charge. It is
C  released under the CeCILL-C license 
C  (see doc/CeCILL-C_V1-en.txt, doc/CeCILL-C_V1-fr.txt, and
C  https://cecill.info/licences/Licence_CeCILL-C_V1-en.html)
C
      MODULE zmumps_lr_stats
      USE zmumps_lr_type
      IMPLICIT NONE
      DOUBLE PRECISION :: mry_cb_fr, 
     &                    mry_cb_lrgain,
     &                    mry_lu_fr,
     &                    mry_lu_lrgain,
     &                    global_mry_lpro_compr,
     &                    global_mry_ltot_compr
      INTEGER :: cnt_nodes
      DOUBLE PRECISION :: flop_lrgain,
     &                    flop_facto_fr,
     &                    flop_facto_lr,
     &                    flop_panel,
     &                    flop_trsm,
     &                    flop_trsm_fr,
     &                    flop_trsm_lr,
     &                    flop_update_fr,
     &                    flop_update_lr,
     &                    flop_update_lrlr1,
     &                    flop_update_lrlr2,
     &                    flop_update_lrlr3,
     &                    flop_update_frlr,
     &                    flop_update_frfr
      DOUBLE PRECISION :: flop_compress,
     &                    flop_cb_compress,
     &                    flop_midblk_compress,
     &                    flop_frswap_compress,
     &                    flop_accum_compress,
     &                    flop_decompress,
     &                    flop_cb_decompress,
     &                    flop_frfronts
      DOUBLE PRECISION :: factor_processed_fraction
      INTEGER(KIND=8)  :: factor_size
      DOUBLE PRECISION :: total_flop
      DOUBLE PRECISION :: time_update
      DOUBLE PRECISION :: time_update_lrlr1
      DOUBLE PRECISION :: time_update_lrlr2
      DOUBLE PRECISION :: time_update_lrlr3
      DOUBLE PRECISION :: time_update_frlr
      DOUBLE PRECISION :: time_update_frfr
      DOUBLE PRECISION :: time_compress
      DOUBLE PRECISION :: time_midblk_compress
      DOUBLE PRECISION :: time_frswap_compress
      DOUBLE PRECISION :: time_cb_compress
      DOUBLE PRECISION :: time_lr_module
      DOUBLE PRECISION :: time_upd_nelim
      DOUBLE PRECISION :: time_lrtrsm
      DOUBLE PRECISION :: time_frtrsm
      DOUBLE PRECISION :: time_panel
      DOUBLE PRECISION :: time_fac_i
      DOUBLE PRECISION :: time_fac_mq
      DOUBLE PRECISION :: time_fac_sq
      DOUBLE PRECISION :: TIME_FRFRONTS
      DOUBLE PRECISION :: time_diagcopy
      DOUBLE PRECISION :: time_decomp
      DOUBLE PRECISION :: time_decomp_ucfs
      DOUBLE PRECISION :: time_decomp_asm1
      DOUBLE PRECISION :: time_decomp_locasm2
      DOUBLE PRECISION :: time_decomp_maplig1
      DOUBLE PRECISION :: time_decomp_asms2s
      DOUBLE PRECISION :: time_decomp_asms2m
      DOUBLE PRECISION :: time_lrana_lrgrouping
      DOUBLE PRECISION :: time_lrana_sepgrouping
      DOUBLE PRECISION :: time_lrana_gethalo
      DOUBLE PRECISION :: time_lrana_kway
      DOUBLE PRECISION :: time_lrana_gnew
      DOUBLE PRECISION :: avg_flop_facto_lr
      DOUBLE PRECISION :: MIN_FLOP_FACTO_LR
      DOUBLE PRECISION :: max_flop_facto_lr
      INTEGER :: total_nblocks_ass, total_nblocks_cb
      INTEGER :: min_blocksize_ass, MAX_BLOCKSIZE_ASS
      INTEGER :: MIN_BLOCKSIZE_CB, max_blocksize_cb
      DOUBLE PRECISION :: avg_blocksize_ass, avg_blocksize_cb
      CONTAINS
      SUBROUTINE collect_blocksizes(CUT,NPARTSASS,NPARTSCB)
        INTEGER, INTENT(IN) :: NPARTSASS, NPARTSCB
        INTEGER, POINTER, DIMENSION(:) :: CUT
        INTEGER :: LOC_MIN_ASS, LOC_MIN_CB, LOC_MAX_ASS, LOC_MAX_CB,
     &             LOC_TOT_ASS, LOC_TOT_CB
        DOUBLE PRECISION :: LOC_AVG_ASS, LOC_AVG_CB 
        INTEGER :: I
        loc_tot_ass = 0
        loc_tot_cb = 0
        loc_avg_ass = 0.d0
        loc_avg_cb = 0.d0
        loc_min_ass = 100000
        loc_min_cb = 100000
        loc_max_ass = 0
        loc_max_cb = 0
        DO i = 1,npartsass
          loc_avg_ass = ( loc_tot_ass * loc_avg_ass
     &                        + cut(i+1) - cut(i) )
     &                        / (loc_tot_ass + 1)
          loc_tot_ass = loc_tot_ass + 1
          IF (cut(i+1) - cut(i) .LE. loc_min_ass) THEN
            loc_min_ass = cut(i+1) - cut(i)
          END IF
          IF (cut(i+1) - cut(i) .GE. loc_max_ass) THEN
            loc_max_ass = cut(i+1) - cut(i)
          END IF
        END DO
        DO i = npartsass+1,npartsass+npartscb
          loc_avg_cb = ( loc_tot_cb * loc_avg_cb
     &                        + cut(i+1) - cut(i) )
     &                        / (loc_tot_cb + 1)
          loc_tot_cb = loc_tot_cb + 1
          IF (cut(i+1) - cut(i) .LE. loc_min_cb) THEN
            loc_min_cb = cut(i+1) - cut(i)
          END IF
          IF (cut(i+1) - cut(i) .GE. loc_max_cb) THEN
            loc_max_cb = cut(i+1) - cut(i)
          END IF
        END DO
        avg_blocksize_ass = (total_nblocks_ass*avg_blocksize_ass
     &     + loc_tot_ass*loc_avg_ass) / (total_nblocks_ass+loc_tot_ass)
        avg_blocksize_cb = (total_nblocks_cb*avg_blocksize_cb
     &     + loc_tot_cb*loc_avg_cb) / (total_nblocks_cb+loc_tot_cb)
        total_nblocks_ass = total_nblocks_ass + loc_tot_ass
        total_nblocks_cb = total_nblocks_cb + loc_tot_cb
        min_blocksize_ass = min(min_blocksize_ass,loc_min_ass)
        min_blocksize_cb = min(min_blocksize_cb,loc_min_cb)
        max_blocksize_ass = max(max_blocksize_ass,loc_max_ass)
        max_blocksize_cb = max(max_blocksize_cb,loc_max_cb)
      END SUBROUTINE collect_blocksizes
      SUBROUTINE upd_flop_decompress(F, CB)
          DOUBLE PRECISION, INTENT(IN) :: F
          LOGICAL, INTENT(IN) :: CB
!$OMP     ATOMIC UPDATE
          flop_decompress = flop_decompress + f
!$OMP     END ATOMIC
          IF (cb) THEN
!$OMP       ATOMIC UPDATE
            flop_cb_decompress = flop_cb_decompress + f
!$OMP       END ATOMIC
          ENDIF
          RETURN
      END SUBROUTINE upd_flop_decompress
      SUBROUTINE upd_flop_compress(LR_B, REC_ACC, 
     &         CB_COMPRESS, FRSWAP)
        TYPE(lrb_type),INTENT(IN) :: LR_B
        INTEGER(8) :: M,N,K
        DOUBLE PRECISION :: HR_COST,BUILDQ_COST,
     &  hr_and_buildq_cost
        LOGICAL, OPTIONAL :: REC_ACC, CB_COMPRESS, FRSWAP
        m = int(lr_b%M,8)
        n = int(lr_b%N,8)
        k = int(lr_b%K,8)
        hr_cost =  dble(k*k*k/3_8 + 4_8*k*m*n - (2_8*m+n)*k*k)
        IF (lr_b%ISLR) THEN 
          buildq_cost = dble(2_8*k*k*m - k*k*k)
        ELSE 
          buildq_cost = 0.0d0
        END IF
        hr_and_buildq_cost = hr_cost + buildq_cost
!$OMP   ATOMIC UPDATE
        flop_compress = flop_compress + hr_and_buildq_cost
!$OMP   END ATOMIC
        IF (present(rec_acc)) THEN
          IF (rec_acc) THEN
!$OMP       ATOMIC UPDATE
            flop_accum_compress = flop_accum_compress +
     &                            hr_and_buildq_cost
!$OMP       END ATOMIC
          ENDIF
        ENDIF
        IF (present(cb_compress)) THEN
          IF (cb_compress) THEN
!$OMP       ATOMIC UPDATE
            flop_cb_compress = flop_cb_compress +
     &                         hr_and_buildq_cost 
!$OMP       END ATOMIC
          ENDIF
        ENDIF
        IF (present(frswap)) THEN
          IF (frswap) THEN
!$OMP       ATOMIC UPDATE
            flop_frswap_compress = flop_frswap_compress +
     &                             hr_and_buildq_cost
!$OMP       END ATOMIC
          ENDIF
        ENDIF
      RETURN
      END SUBROUTINE upd_flop_compress
      SUBROUTINE upd_flop_trsm(LRB, LorU)
          TYPE(lrb_type),INTENT(IN) :: LRB
          INTEGER,INTENT(IN) :: LorU
          DOUBLE PRECISION :: LR_COST, FR_COST, LR_GAIN
          IF (loru.EQ.0) THEN 
            fr_cost = dble(lrb%M*lrb%N*lrb%N)
            IF (lrb%ISLR) THEN
              lr_cost = dble(lrb%K*lrb%N*lrb%N)
            ELSE
              lr_cost = fr_cost
            ENDIF
          ELSE 
            fr_cost = dble(lrb%M-1)*dble(lrb%N*lrb%N)
            IF (lrb%ISLR) THEN
              lr_cost = dble(lrb%N-1)*dble(lrb%N*lrb%K)
            ELSE
              lr_cost = fr_cost
            ENDIF
          ENDIF
          lr_gain = fr_cost - lr_cost
!$OMP     ATOMIC UPDATE
          flop_lrgain  = flop_lrgain + lr_gain
!$OMP     END ATOMIC
      RETURN
      END SUBROUTINE upd_flop_trsm
      SUBROUTINE upd_flop_update(LRB1, LRB2,
     &      MIDBLK_COMPRESS, RANK_IN, BUILDQ,
     &      IS_SYMDIAG, LUA_ACTIVATED, REC_ACC)
        TYPE(lrb_type),INTENT(IN) :: LRB1,LRB2
        LOGICAL, INTENT(IN) :: BUILDQ, IS_SYMDIAG, LUA_ACTIVATED
        INTEGER, INTENT(IN) :: RANK_IN, MIDBLK_COMPRESS
        LOGICAL, INTENT(IN), OPTIONAL :: REC_ACC
        DOUBLE PRECISION :: COST_FR, COST_LR, COST_LRLR1, COST_LRLR2,
     &                      cost_lrlr3, cost_frlr, cost_frfr, 
     &                      cost_compress, cost_lr_and_compress, lr_gain
        DOUBLE PRECISION :: M1,N1,K1,M2,N2,K2,RANK
        LOGICAL :: REC_ACC_LOC
        M1 = dble(lrb1%M)
        n1 = dble(lrb1%N)
        k1 = dble(lrb1%K)
        m2 = dble(lrb2%M)
        n2 = dble(lrb2%N)
        k2 = dble(lrb2%K)
        rank = dble(rank_in)
        cost_lrlr1 = 0.0d0
        cost_lrlr2 = 0.0d0
        cost_lrlr3 = 0.0d0
        cost_frlr = 0.0d0
        cost_frfr = 0.0d0
        cost_compress = 0.0d0
        IF (present(rec_acc)) THEN
          rec_acc_loc = rec_acc
        ELSE
          rec_acc_loc = .false.
        ENDIF
        IF ((.NOT.lrb1%ISLR).AND.(.NOT.lrb2%ISLR)) THEN
          cost_frfr = 2.0d0*m1*m2*n1
          cost_lr = 2.0d0*m1*m2*n1
          cost_fr = 2.0d0*m1*m2*n1
        ELSEIF (lrb1%ISLR.AND.(.NOT.lrb2%ISLR)) THEN
          cost_frlr = 2.0d0*k1*m2*n1
          cost_lrlr3 = 2.0d0*m1*m2*k1
          cost_lr = cost_frlr + cost_lrlr3
          cost_fr = 2.0d0*m1*m2*n1
        ELSEIF ((.NOT.lrb1%ISLR).AND.lrb2%ISLR) THEN
          cost_frlr = 2.0d0*m1*k2*n1 
          cost_lrlr3 = 2.0d0*m1*m2*k2
          cost_lr = cost_frlr + cost_lrlr3
          cost_fr = 2.0d0*m1*m2*n1
        ELSE
          IF (midblk_compress.GE.1) THEN
            cost_compress =  rank*rank*rank/3.0d0 + 
     &                       4.0d0*rank*k1*k2 - 
     &                       (2.0d0*k1+k2)*rank*rank
            IF (buildq) THEN
              cost_compress = cost_compress + 4.0d0*rank*rank*k1 
     &                                      - rank*rank*rank
            ENDIF
          ENDIF
          cost_lrlr1 = 2.0d0*k1*k2*n1
          IF ((midblk_compress.GE.1).AND.buildq) THEN
            cost_lrlr2 = 2.0d0*k1*m1*rank + 2.0d0*k2*m2*rank
            cost_lrlr3 = 2.0d0*m1*m2*rank
          ELSE
            IF (k1 .GE. k2) THEN
              cost_lrlr2 = 2.0d0*k1*m1*k2
              cost_lrlr3 = 2.0d0*m1*m2*k2
            ELSE
              cost_lrlr2 = 2.0d0*k1*m2*k2
              cost_lrlr3 = 2.0d0*m1*m2*k1
            ENDIF
          ENDIF
          cost_lr = cost_lrlr1 + cost_lrlr2 + cost_lrlr3
          cost_fr = 2.0d0*m1*m2*n1
        ENDIF
        IF (is_symdiag) THEN
          cost_fr = cost_fr/2.0d0
          cost_lrlr3 = cost_lrlr3/2.0d0
          cost_frfr = cost_frfr/2.0d0
          cost_lr = cost_lr - cost_lrlr3 - cost_frfr
        ENDIF
        IF (lua_activated) THEN
          cost_lr = cost_lr - cost_lrlr3
          cost_lrlr3 = 0.0d0
          IF (rec_acc_loc) THEN
            cost_lr_and_compress = cost_lr + cost_compress
!$OMP       ATOMIC UPDATE
            flop_compress  = flop_compress + cost_lr_and_compress
!$OMP       END ATOMIC
          ENDIF
        ENDIF
        IF (.NOT.rec_acc_loc) THEN
!$OMP     ATOMIC UPDATE
          flop_compress  = flop_compress  + cost_compress
!$OMP     END ATOMIC
          lr_gain = cost_fr - cost_lr
!$OMP     ATOMIC UPDATE
          flop_lrgain = flop_lrgain + lr_gain
!$OMP     END ATOMIC
        ENDIF
      END SUBROUTINE upd_flop_update
      SUBROUTINE upd_flop_update_lrlr3(LRB, NIV)
        TYPE(lrb_type),INTENT(IN) :: LRB
        INTEGER,INTENT(IN) :: NIV
        DOUBLE PRECISION :: FLOP_COST
        flop_cost = 2.0d0*dble(lrb%M)*dble(lrb%N)*dble(lrb%K)
!$OMP   ATOMIC UPDATE
        flop_lrgain = flop_lrgain - flop_cost
!$OMP   END ATOMIC
        RETURN
      END SUBROUTINE upd_flop_update_lrlr3
      SUBROUTINE upd_flop_root(KEEP50, NFRONT, NPIV,
     &           NPROW, NPCOL, MYID)
        INTEGER, intent(in) :: KEEP50, NFRONT, NPIV,
     &           nprow, npcol, myid
        DOUBLE PRECISION :: COST, COST_PER_PROC
        INTEGER, PARAMETER :: LEVEL3 = 3
        CALL mumps_get_flops_cost(nfront, npiv, nfront, keep50, level3, 
     &                            cost)
        cost_per_proc = dble(int( cost,8) / int(nprow * npcol,8))
!$OMP   ATOMIC UPDATE
        flop_frfronts = flop_frfronts + cost_per_proc
!$OMP   END ATOMIC
        RETURN
      END SUBROUTINE upd_flop_root
      SUBROUTINE init_stats_global(id)
        USE zmumps_struc_def
        TYPE (ZMUMPS_STRUC), TARGET :: id
        mry_lu_fr = 0.d0
        mry_lu_lrgain = 0.d0
        mry_cb_fr = 0.d0
        mry_cb_lrgain = 0.d0
        flop_facto_fr = 0.d0 
        flop_facto_lr = 0.d0
        flop_lrgain = 0.d0
        flop_cb_compress = 0.d0
        flop_cb_decompress = 0.d0
        flop_decompress = 0.d0
        flop_update_fr = 0.d0 
        flop_update_lr = 0.d0
        flop_update_lrlr1 = 0.d0
        flop_update_lrlr2 = 0.d0
        flop_update_lrlr3 = 0.d0
        flop_update_frlr = 0.d0
        flop_update_frfr = 0.d0
        flop_midblk_compress = 0.d0
        flop_trsm_fr = 0.d0 
        flop_trsm_lr = 0.d0
        flop_compress = 0.d0
        flop_accum_compress = 0.d0
        flop_frswap_compress = 0.d0
        flop_panel = 0.d0
        flop_trsm = 0.d0
        flop_frfronts = 0.d0
        total_nblocks_ass = 0
        total_nblocks_cb = 0
        avg_blocksize_ass = 0.d0
        avg_blocksize_cb = 0.d0
        min_blocksize_ass = huge(1)
        max_blocksize_ass = 0
        min_blocksize_cb = huge(1)
        max_blocksize_cb = 0
        cnt_nodes = 0
        time_update = 0.d0 
        time_midblk_compress = 0.d0 
        time_update_lrlr1 = 0.d0 
        time_update_lrlr2 = 0.d0 
        time_update_lrlr3 = 0.d0 
        time_update_frlr = 0.d0 
        time_update_frfr = 0.d0 
        time_compress = 0.d0 
        time_cb_compress = 0.d0 
        time_lr_module = 0.d0 
        time_upd_nelim = 0.d0 
        time_lrtrsm = 0.d0 
        time_frtrsm = 0.d0 
        time_panel = 0.d0 
        time_fac_i = 0.d0 
        time_fac_mq = 0.d0 
        time_fac_sq = 0.d0 
        time_frfronts = 0.d0 
        time_diagcopy = 0.d0 
        time_frswap_compress = 0.d0 
        time_decomp = 0.d0 
        time_decomp_ucfs = 0.d0 
        time_decomp_asm1 = 0.d0 
        time_decomp_locasm2 = 0.d0 
        time_decomp_maplig1 = 0.d0 
        time_decomp_asms2s = 0.d0 
        time_decomp_asms2m = 0.d0 
      END SUBROUTINE init_stats_global
      SUBROUTINE upd_mry_lu_fr(NASS, NCB, SYM, NELIM)
        INTEGER,INTENT(IN) :: NASS, NCB, SYM, NELIM
        DOUBLE PRECISION :: MRY
        INTEGER :: NPIV
        npiv = nass - nelim
        IF (sym .GT. 0) THEN
           mry = dble(npiv)*(dble(npiv)+1.d0)/2.d0 
     &         + dble(npiv)*dble(ncb+nelim)
        ELSE
           mry = dble(npiv)*dble(npiv) 
     &         + 2.0d0*dble(npiv)*dble(ncb+nelim)
        END IF
!$OMP   ATOMIC UPDATE
        mry_lu_fr  = mry_lu_fr + mry
!$OMP   END ATOMIC
      RETURN
      END SUBROUTINE upd_mry_lu_fr
      SUBROUTINE upd_mry_cb_fr(NROWS, NCOLS, SYM)
        INTEGER,INTENT(IN) :: NROWS, NCOLS, SYM
        DOUBLE PRECISION :: MRY
        IF (sym.EQ.0) THEN
          mry = dble(ncols)*dble(nrows)
        ELSE
          mry = dble(ncols-nrows)*dble(nrows) +
     &                dble(nrows)*dble(nrows+1)/2.d0
        ENDIF
!$OMP   ATOMIC UPDATE
        mry_cb_fr = mry_cb_fr + mry
!$OMP   END ATOMIC
        RETURN
      END SUBROUTINE upd_mry_cb_fr
      SUBROUTINE upd_mry_cb_lrgain(LRB
     &                            )
        TYPE(lrb_type),  INTENT(IN) :: LRB
        DOUBLE PRECISION :: LRGAIND
        lrgaind = dble(lrb%M*lrb%N-(lrb%M+lrb%N)*lrb%K)
!$OMP   ATOMIC UPDATE
        mry_cb_lrgain = mry_cb_lrgain + lrgaind
!$OMP   END ATOMIC
        RETURN
      END SUBROUTINE upd_mry_cb_lrgain
      SUBROUTINE upd_mry_lu_lrgain( BLR_PANEL, NBBLOCKS
     &           )
        INTEGER,INTENT(IN) :: NBBLOCKS
        TYPE(LRB_TYPE),  INTENT(IN) :: BLR_PANEL(:)
        DOUBLE PRECISION :: MRY
        INTEGER :: I
        mry    = 0.0d0
        DO i = 1, nbblocks
          IF (blr_panel(i)%ISLR) THEN
            mry = mry + dble(blr_panel(i)%M*blr_panel(i)%N 
     &            - blr_panel(i)%K*(blr_panel(i)%M + blr_panel(i)%N)) 
          ENDIF
        ENDDO
!$OMP   ATOMIC UPDATE
        mry_lu_lrgain  = mry_lu_lrgain  + mry
!$OMP   END ATOMIC
      RETURN
      END SUBROUTINE upd_mry_lu_lrgain
      SUBROUTINE upd_flop_facto_fr( NFRONT, NASS, NPIV, SYM, NIV)
          INTEGER,INTENT(IN) :: NFRONT, SYM, NASS, NPIV, NIV
          DOUBLE PRECISION   :: FLOP
          CALL MUMPS_GET_FLOPS_COST(NFRONT, NPIV, NASS, 
     &                              sym, niv, flop)
!$OMP     ATOMIC UPDATE
          flop_facto_fr = flop_facto_fr + flop
!$OMP     END ATOMIC
      END SUBROUTINE upd_flop_facto_fr
      SUBROUTINE stats_compute_flop_slave_type2( NROW1, NCOL1,
     &                NASS1, KEEP50, INODE)
          INTEGER,INTENT(IN) :: NROW1, NCOL1, KEEP50, NASS1, INODE
          DOUBLE PRECISION   :: NROW2, NCOL2, NASS2
          DOUBLE PRECISION   :: FLOP
          NROW2 = dble(nrow1)
          ncol2 = dble(ncol1)
          nass2 = dble(nass1)
          IF (keep50.EQ.0) THEN
            flop = nrow2*nass2*nass2         
     &              + 2.0d0*nrow2*nass2*(ncol2-nass2) 
          ELSE
             flop =
     &            nrow2*nass2*nass2
     &          + nrow2*nass2*nrow2
     &          + 2.0d0*nrow2*nass2*(ncol2-nass2-nrow2)
          ENDIF
!$OMP     ATOMIC UPDATE
          flop_facto_fr = flop_facto_fr + flop
!$OMP     END ATOMIC
      RETURN
      END SUBROUTINE stats_compute_flop_slave_type2
      SUBROUTINE upd_flop_frfronts(NFRONT, NPIV, NASS, SYM, 
     &                                        NIV)
          INTEGER, INTENT(IN) :: NFRONT, NPIV, NASS, SYM, NIV
          DOUBLE PRECISION    :: FLOP_FAC
          CALL mumps_get_flops_cost(nfront, npiv, nass, 
     &                              sym, niv, flop_fac)
!$OMP     ATOMIC UPDATE
          flop_frfronts = flop_frfronts + flop_fac
!$OMP     END ATOMIC
      RETURN
      END SUBROUTINE upd_flop_frfronts
      SUBROUTINE upd_flop_frfront_slave(NROW1, NCOL1, NASS1,
     &                                        KEEP50, INODE)
          INTEGER,INTENT(IN) :: NROW1, NCOL1, KEEP50, NASS1, INODE
          DOUBLE PRECISION   :: NROW2, NCOL2, NASS2
          DOUBLE PRECISION   :: FLOP
          nrow2 = dble(nrow1)
          ncol2 = dble(ncol1)
          nass2 = dble(nass1)
          IF (keep50.EQ.0) THEN
            flop = nrow2*nass2*nass2         
     &              + 2.0d0*nrow2*nass2*(ncol2-nass2) 
          ELSE
             flop =
     &            nrow2*nass2*nass2
     &          + nrow2*nass2*nrow2
     &          + 2.0d0*nrow2*nass2*(ncol2-nass2-nrow2)
          ENDIF
!$OMP     ATOMIC UPDATE
          flop_frfronts = flop_frfronts + flop
!$OMP     END ATOMIC
      RETURN
      END SUBROUTINE upd_flop_frfront_slave
      SUBROUTINE compute_global_gains(NB_ENTRIES_FACTOR, 
     &                FLOP_NUMBER, NB_ENTRIES_FACTOR_withLR,
     &                PROKG, MPG)
        INTEGER(8), INTENT(IN) :: NB_ENTRIES_FACTOR   
        INTEGER, INTENT(IN)    :: MPG
        LOGICAL, INTENT(IN)    :: PROKG
        DOUBLE PRECISION, INTENT(IN)        :: FLOP_NUMBER   
        INTEGER(8), INTENT(OUT) :: 
     &                  NB_ENTRIES_FACTOR_withLR 
        IF (nb_entries_factor < 0) THEN
         IF (prokg.AND.mpg.GT.0) THEN
          WRITE(mpg,*) "NEGATIVE NUMBER OF ENTRIES IN FACTOR"
          WRITE(mpg,*) "===> OVERFLOW ?"
         END IF
        END IF
        IF (mry_lu_fr .EQ. 0) THEN
           global_mry_lpro_compr = 100.0d0
        ELSE
           global_mry_lpro_compr = 100.0d0 *
     &                             mry_lu_lrgain/mry_lu_fr
        ENDIF
        IF (mry_cb_fr .EQ. 0) THEN 
          mry_cb_fr = 100.0d0
        END IF
        nb_entries_factor_withlr = nb_entries_factor -
     &                             int(mry_lu_lrgain,8)
        IF (nb_entries_factor.EQ.0) THEN
          factor_processed_fraction = 100.0d0
          global_mry_ltot_compr = 100.0d0
        ELSE
          factor_processed_fraction = 100.0d0 *
     &                            mry_lu_fr/dble(nb_entries_factor)
          global_mry_ltot_compr = 
     &            100.0d0*mry_lu_lrgain/dble(nb_entries_factor)
        ENDIF
        total_flop = flop_number
        flop_facto_lr = flop_facto_fr - flop_lrgain + flop_compress 
     &                                              + flop_decompress
        RETURN
      END SUBROUTINE compute_global_gains
      SUBROUTINE saveandwrite_gains(LOCAL, K489, DKEEP, N, 
     &         ICNTL36,
     &         DEPTH, BCKSZ, NASSMIN, NFRONTMIN, SYM, K486,
     &         K472, K475, K478, K480, K481, K483, K484, 
     &         K8110, K849, 
     &         NBTREENODES, NPROCS, MPG, PROKG)
        INTEGER, INTENT(IN) :: LOCAL,K489,DEPTH, N,
     &      ICNTL36, BCKSZ,NASSMIN,
     &      nfrontmin, k486, nbtreenodes, mpg, 
     &      k472, k475, k478, k480, k481, k483, k484, 
     &      sym, nprocs
        INTEGER(8), INTENT(IN) :: K8110, K849
        LOGICAL, INTENT(IN) :: PROKG
        DOUBLE PRECISION :: DKEEP(230)
        LOGICAL PROK
        prok = (prokg.AND.(mpg.GE.0))
        IF (prok) THEN
        WRITE(mpg,'(/A,A)') 
     & '-------------- Beginning of BLR statistics -------------------',
     & '--------------'
        WRITE(mpg,'(A,I2)') 
     & ' ICNTL(36) BLR variant                            = ', icntl36
        WRITE(mpg,'(A,ES8.1)')  
     & ' CNTL(7)   Dropping parameter controlling accuracy = ',
     &                          dkeep(8)
        WRITE(mpg,'(A)') 
     &          ' Statistics after BLR factorization :'
        WRITE(mpg,'(A,I8)') 
     &    '     Number of BLR fronts                     = ',
     &                          cnt_nodes
        ENDIF  
        IF (prok) WRITE(mpg,'(A,F8.1,A)')
     &    '     Fraction of factors in BLR fronts        =',
     &                factor_processed_fraction,'% ' 
        IF (prok) THEN
          WRITE(mpg,'(A)') 
     &  '     Statistics on the number of entries in factors :'
          WRITE(mpg,'(A,ES10.3,A,F5.1,A)') 
     &  '     INFOG(29) Theoretical nb of entries in factors      ='
     &     ,dble(k8110),' (100.0%)'
          WRITE(mpg,'(A,ES10.3,A,F5.1,A)') 
     &  '     INFOG(35) Effective nb of entries  (% of INFOG(29)) ='
     &     ,dble(k849),' ('
     &     ,dble(100)*(dble(k849)/dble(max(k8110,1_8)))
     &     ,'%)'
        ENDIF
        IF (prok) WRITE(mpg,'(A)')
     &  '     Statistics on operation counts (OPC):'
        total_flop = max(total_flop,epsilon(1.0d0))
        dkeep(55)=dble(total_flop)
        dkeep(60)=dble(100)
        dkeep(56)=dble(flop_facto_lr+flop_frfronts)
        dkeep(61)=dble(100*(flop_facto_lr+flop_frfronts)/total_flop)
        IF (prok) THEN 
        WRITE(mpg,'(A,ES10.3,A,F5.1,A)') 
     &  '     RINFOG(3) Total theoretical operations counts       ='
     &     ,total_flop,' (',100*total_flop/total_flop,'%)'
        WRITE(mpg,'(A,ES10.3,A,F5.1,A)') 
     &  '     RINFOG(14) Total effective OPC     (% of RINFOG(3)) ='
     &     ,flop_facto_lr+flop_frfronts,' ('
     &,100*(flop_facto_lr+flop_frfronts)/total_flop
     &,'%)'
        ENDIF
      IF (prok) WRITE(mpg,'(A,A)') 
     & '-------------- End of BLR statistics -------------------------',
     & '--------------'
      RETURN
      END SUBROUTINE saveandwrite_gains
      END MODULE zmumps_lr_stats