1C
2C  This file is part of MUMPS 5.1.2, released
3C  on Mon Oct  2 07:37:01 UTC 2017
4C
5C
6C  Copyright 1991-2017 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
7C  University of Bordeaux.
8C
9C  This version of MUMPS is provided to you free of charge. It is
10C  released under the CeCILL-C license:
11C  http://www.cecill.info/licences/Licence_CeCILL-C_V1-en.html
12C
13      SUBROUTINE MUMPS_ESTIM_FLOPS( INODE, N, PROCNODE_STEPS,
14     &           SLAVEF,
15     &           ND, FILS, FRERE_STEPS, STEP, PIMASTER,
16     &           KEEP28, KEEP50, KEEP253,
17     &           FLOP1,
18     &           IW, LIW, XSIZE )
19      IMPLICIT NONE
20      INTEGER INODE, N, KEEP50, LIW, SLAVEF, KEEP28, KEEP253
21      INTEGER PROCNODE_STEPS(KEEP28), ND(KEEP28),
22     &        FILS(N), FRERE_STEPS(KEEP28),
23     &        STEP(N),
24     & PIMASTER(KEEP28),
25     &  IW( LIW )
26      INTEGER XSIZE
27      DOUBLE PRECISION FLOP1
28      INTEGER NUMORG, IN, NASS, IFSON, NUMSTK, NFRONT, NPIV, NCB,
29     &        LEVEL, ISON
30      LOGICAL MUMPS_IN_OR_ROOT_SSARBR
31      INTEGER MUMPS_TYPENODE
32      EXTERNAL MUMPS_IN_OR_ROOT_SSARBR, MUMPS_TYPENODE
33      INCLUDE 'mumps_headers.h'
34      FLOP1 = 0.0D0
35      IF (MUMPS_IN_OR_ROOT_SSARBR(PROCNODE_STEPS(STEP(INODE)),
36     &                SLAVEF) ) RETURN
37      IN     = INODE
38      NUMORG = 0
39   10 NUMORG = NUMORG + 1
40      IN = FILS(IN)
41      IF (IN .GT. 0) GOTO 10
42      NUMSTK = 0
43      NASS = 0
44      IFSON = -IN
45      ISON = IFSON
46      IF (ISON .EQ. 0) GOTO 30
47   20 NUMSTK = NUMSTK + 1
48      NASS = NASS + IW(PIMASTER(STEP(ISON)) + 1 +XSIZE)
49      ISON = FRERE_STEPS(STEP(ISON))
50      IF (ISON .GT. 0) GOTO 20
51   30 NFRONT = ND(STEP(INODE)) + NASS + KEEP253
52      NPIV  = NASS + NUMORG
53      NCB   = NFRONT - NPIV
54      LEVEL = MUMPS_TYPENODE(PROCNODE_STEPS(STEP(INODE)),SLAVEF)
55      CALL MUMPS_GET_FLOPS_COST(NFRONT,NPIV,NPIV,KEEP50,LEVEL,FLOP1)
56      RETURN
57      END SUBROUTINE MUMPS_ESTIM_FLOPS
58      SUBROUTINE MUMPS_UPDATE_FLOPS_ROOT(OPELIW, KEEP50, NFRONT, NPIV,
59     &           NPROW, NPCOL, MYID)
60      DOUBLE PRECISION, intent(inout) :: OPELIW
61      INTEGER, intent(in) :: KEEP50, NFRONT, NPIV,
62     &           NPROW, NPCOL, MYID
63      DOUBLE PRECISION :: COST, COST_PER_PROC
64      INTEGER, PARAMETER :: LEVEL3 = 3
65      CALL MUMPS_GET_FLOPS_COST(NFRONT, NPIV, NFRONT, KEEP50, LEVEL3,
66     &                          COST)
67      COST_PER_PROC = dble(int( COST,8) / int(NPROW * NPCOL,8))
68      OPELIW = OPELIW + COST_PER_PROC
69      RETURN
70      END SUBROUTINE MUMPS_UPDATE_FLOPS_ROOT
71      SUBROUTINE MUMPS_GET_FLOPS_COST(NFRONT,NPIV,NASS,
72     &                                 KEEP50,LEVEL,COST)
73      IMPLICIT NONE
74      INTEGER, intent(in) :: NFRONT,NPIV,KEEP50,LEVEL, NASS
75      DOUBLE PRECISION, intent(out) :: COST
76      IF (KEEP50.EQ.0) THEN
77        IF (LEVEL.EQ.1 .OR. LEVEL.EQ.3) THEN
78          COST = dble(2) * dble(NFRONT) * dble(NPIV) *
79     &      dble(NFRONT - NPIV - 1) +
80     &      dble(NPIV) * dble(NPIV + 1) * dble(2 * NPIV + 1)
81     &          / dble(3)
82          COST = COST + dble(2 * NFRONT - NPIV - 1)
83     &      * dble(NPIV) /dble(2)
84        ELSEIF (LEVEL.EQ.2) THEN
85          COST = dble(2*NASS)*dble(NFRONT) -
86     &          dble(NASS+NFRONT)*dble(NPIV+1)
87          COST = dble(NPIV)*COST +
88     &     dble(2 * NASS - NPIV - 1) * dble(NPIV) / dble(2) +
89     &     dble(NPIV) * dble(NPIV + 1) *
90     &     dble(2 * NPIV + 1) /dble(3)
91        ENDIF
92      ELSE
93        IF (LEVEL.EQ.1 .OR. (LEVEL.EQ.3 .AND. KEEP50.EQ.1)) THEN
94          COST = dble(NPIV) * (
95     &          dble( NFRONT ) * dble( NFRONT ) +
96     &          dble( NFRONT ) - (
97     &          dble( NFRONT)*dble(NPIV) + dble(NPIV+1)
98     &          )) +( dble(NPIV)*dble(NPIV+1)
99     &          *dble(2*NPIV+1))/ dble(6)
100        ELSE IF (LEVEL.EQ.3.AND.KEEP50.EQ.2) THEN
101          COST = dble(2) * dble(NFRONT) * dble(NPIV) *
102     &      dble(NFRONT - NPIV - 1) +
103     &      dble(NPIV) * dble(NPIV + 1) *
104     &      dble(2 * NPIV + 1) / dble(3)
105          COST = COST + dble(2 * NFRONT - NPIV - 1)
106     &         * dble(NPIV) / dble(2)
107        ELSE
108          COST = dble(NPIV) * (
109     &          dble( NASS ) * dble( NASS ) + dble( NASS )
110     &        - ( dble( NASS) * dble(NPIV) + dble( NPIV + 1 ) ) )
111     &        + ( dble(NPIV)*dble(NPIV+1)*dble(2*NPIV+1) )
112     &        / dble( 6 )
113        ENDIF
114      ENDIF
115      RETURN
116      END SUBROUTINE MUMPS_GET_FLOPS_COST
117