dmumps_fac_par_m Module Reference

Functions/Subroutines
subroutine	dmumps_fac_par (n, iw, liw, a, la, nstk_steps, nd, fils, step, frere, dad, cand, istep_to_iniv2, tab_pos_in_pere, nstepsdone, opass, opeli, nelva, comp, maxfrt, nmaxnpiv, ntotpv, noffnegpv, nb22t1, nb22t2, nbtiny, det_exp, det_mant, det_sign, ptrist, ptrast, pimaster, pamaster, ptrarw, ptraiw, itloc, rhs_mumps, ipool, lpool, l0_omp_mapping, ll0_omp_mapping, mumps_tps_arr, dmumps_tps_arr, ltps_arr, rinfo, posfac, iwpos, lrlu, iptrlu, lrlus, leaf, nbroot, nbrtot, nbroot_under_l0, uu, icntl, ptlust, ptrfac, info, keep, keep8, procnode_steps, slavef, myid, comm_nodes, myid_nodes, bufr, lbufr, lbufr_bytes, intarr, dblarr, root, perm, nelt, frtptr, frtelt, lptrar, comm_load, ass_irecv, seuil, seuil_ldlt_niv2, mem_distrib, ne, dkeep, pivnul_list, lpn_list, lrgroups)
subroutine	dmumps_change_header (header, keep253)

Function/Subroutine Documentation

dmumps_change_header()

subroutine dmumps_fac_par_m::dmumps_change_header	(	integer, dimension( 6 )	header,
		integer	keep253 )

Definition at line 925 of file dfac_par_m.F.

        INTEGER HEADER( 6 ), KEEP253
        INTEGER NFRONT, NASS
        nfront = header(1)
        IF ( header(2) .ne. 0 ) THEN
          WRITE(*,*) ' *** CHG_HEADER ERROR 1 :',header(2)
          CALL mumps_abort()
        END IF
        nass   = abs( header( 3 ) )
        IF ( nass .NE. abs( header( 4 ) ) ) THEN
          WRITE(*,*) ' *** CHG_HEADER ERROR 2 :',header(3:4)
          CALL mumps_abort()
        END IF
        IF ( nass+keep253 .NE. nfront ) THEN
          WRITE(*,*) ' *** CHG_HEADER ERROR 3 : not root',
     &    nass, keep253, nfront
          CALL mumps_abort()
        END IF
        header( 1 ) = keep253 
        header( 2 ) = 0
        header( 3 ) = nfront 
        header( 4 ) = nfront-keep253    
        RETURN

dmumps_fac_par()

subroutine dmumps_fac_par_m::dmumps_fac_par	(	integer	n,
		integer, dimension(liw)	iw,
		integer	liw,
		double precision, dimension(la), target	a,
		integer(8)	la,
		integer, dimension(keep(28))	nstk_steps,
		integer, dimension(keep(28))	nd,
		integer, dimension(n)	fils,
		integer, dimension(n)	step,
		integer, dimension(keep(28))	frere,
		integer, dimension(keep(28))	dad,
		integer, dimension(slavef+1,max(1,keep(56)))	cand,
		integer, dimension(keep(71))	istep_to_iniv2,
		integer, dimension(slavef+2,max(1,keep(56)))	tab_pos_in_pere,
		integer	nstepsdone,
		double precision, intent(inout)	opass,
		double precision, intent(inout)	opeli,
		integer, intent(inout)	nelva,
		integer, intent(inout)	comp,
		integer, intent(inout)	maxfrt,
		integer, intent(inout)	nmaxnpiv,
		integer, intent(inout)	ntotpv,
		integer, intent(inout)	noffnegpv,
		integer, intent(inout)	nb22t1,
		integer, intent(inout)	nb22t2,
		integer, intent(inout)	nbtiny,
		integer, intent(inout)	det_exp,
		double precision, intent(inout)	det_mant,
		integer, intent(inout)	det_sign,
		integer, dimension(keep(28))	ptrist,
		integer(8), dimension(keep(28))	ptrast,
		integer, dimension(keep(28))	pimaster,
		integer(8), dimension(keep(28))	pamaster,
		integer(8), dimension(lptrar), intent(in)	ptrarw,
		integer(8), dimension(lptrar), intent(in)	ptraiw,
		integer, dimension(n+keep(253))	itloc,
		double precision, dimension(keep(255))	rhs_mumps,
		integer, dimension(lpool)	ipool,
		integer	lpool,
		integer, dimension( ll0_omp_mapping ), intent(in)	l0_omp_mapping,
		integer, intent(in)	ll0_omp_mapping,
		type (mumps_tps_t), dimension( ltps_arr ), target	mumps_tps_arr,
		type (dmumps_tps_t), dimension( ltps_arr ), target	dmumps_tps_arr,
		integer, intent(in)	ltps_arr,
		double precision, dimension(40)	rinfo,
		integer(8)	posfac,
		integer	iwpos,
		integer(8)	lrlu,
		integer(8)	iptrlu,
		integer(8)	lrlus,
		integer	leaf,
		integer	nbroot,
		integer	nbrtot,
		integer, intent(in)	nbroot_under_l0,
		double precision	uu,
		integer, dimension(60)	icntl,
		integer, dimension(keep(28))	ptlust,
		integer(8), dimension(keep(28))	ptrfac,
		integer, dimension(80)	info,
		integer, dimension(500)	keep,
		integer(8), dimension(150)	keep8,
		integer, dimension(keep(28))	procnode_steps,
		integer	slavef,
		integer	myid,
		integer	comm_nodes,
		integer	myid_nodes,
		integer, dimension( lbufr )	bufr,
		integer	lbufr,
		integer	lbufr_bytes,
		integer, dimension( keep8(27) )	intarr,
		double precision, dimension( keep8(26) )	dblarr,
		type (dmumps_root_struc)	root,
		integer, dimension(n)	perm,
		integer	nelt,
		integer, dimension( n+1 )	frtptr,
		integer, dimension( nelt )	frtelt,
		integer	lptrar,
		integer	comm_load,
		integer	ass_irecv,
		double precision	seuil,
		double precision	seuil_ldlt_niv2,
		integer, dimension(0: slavef - 1)	mem_distrib,
		integer, dimension(keep(28))	ne,
		double precision, dimension(230)	dkeep,
		integer, dimension(lpn_list)	pivnul_list,
		integer	lpn_list,
		integer, dimension(n)	lrgroups )

Definition at line 16 of file dfac_par_m.F.

!$    USE OMP_LIB
      USE dmumps_dynamic_memory_m, ONLY : 
     &                                    dmumps_dm_freealldynamiccb
      USE dmumps_load
      USE dmumps_ooc
      USE dmumps_fac_asm_master_m
      USE dmumps_fac_asm_master_elt_m
      USE dmumps_fac1_ldlt_m
      USE dmumps_fac2_ldlt_m
      USE dmumps_fac1_lu_m
      USE dmumps_fac2_lu_m
      USE omp_lib
      USE mumps_tps_m
      USE dmumps_tps_m
      USE dmumps_struc_def, ONLY : dmumps_root_struc
      IMPLICIT NONE
      TYPE (DMUMPS_ROOT_STRUC) :: root
      INTEGER N, LIW, LPTRAR, NSTEPSDONE, INFO(80)
      DOUBLE PRECISION, INTENT(INOUT) :: OPASS, OPELI
      INTEGER, INTENT(INOUT) :: NELVA, COMP
      INTEGER, INTENT(INOUT) :: MAXFRT, NTOTPV, NMAXNPIV, NOFFNEGPV
      INTEGER, INTENT(INOUT) :: NB22T1, NB22T2, NBTINY
      INTEGER, INTENT(INOUT) :: DET_SIGN, DET_EXP
      DOUBLE PRECISION, INTENT(INOUT) :: DET_MANT
      INTEGER(8) :: LA
      DOUBLE PRECISION, TARGET :: A(LA)
      INTEGER SLAVEF, COMM_NODES, MYID, MYID_NODES
      INTEGER, DIMENSION(0: SLAVEF - 1) :: MEM_DISTRIB
      INTEGER KEEP(500), ICNTL(60)
      INTEGER(8) KEEP8(150)
      INTEGER LPOOL
      INTEGER PROCNODE_STEPS(KEEP(28))
      INTEGER ITLOC(N+KEEP(253))
      DOUBLE PRECISION :: RHS_MUMPS(KEEP(255))
      INTEGER IW(LIW), NSTK_STEPS(KEEP(28))
      INTEGER(8), INTENT(IN) :: PTRARW(LPTRAR), PTRAIW(LPTRAR)
      INTEGER ND(KEEP(28))
      INTEGER FILS(N),PTRIST(KEEP(28))
      INTEGER STEP(N), FRERE(KEEP(28)), DAD(KEEP(28))
      INTEGER PIMASTER(KEEP(28))
      INTEGER PTLUST(KEEP(28)), PERM(N)
      INTEGER CAND(SLAVEF+1,max(1,KEEP(56)))
      INTEGER   ISTEP_TO_INIV2(KEEP(71)),
     &          TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
      INTEGER IPOOL(LPOOL)
      INTEGER NE(KEEP(28))
      DOUBLE PRECISION RINFO(40)
      INTEGER(8) :: PAMASTER(KEEP(28)), PTRAST(KEEP(28))
      INTEGER(8) :: PTRFAC(KEEP(28))
      INTEGER(8) :: POSFAC, LRLU, LRLUS, IPTRLU
      INTEGER IWPOS, LEAF, NBROOT, NBRTOT
      INTEGER, INTENT(in) :: NBROOT_UNDER_L0
      INTEGER COMM_LOAD, ASS_IRECV
      DOUBLE PRECISION UU, SEUIL, SEUIL_LDLT_NIV2
      INTEGER NELT
      INTEGER FRTPTR( N+1 ), FRTELT( NELT )
      INTEGER LBUFR, LBUFR_BYTES
      INTEGER BUFR( LBUFR )
      DOUBLE PRECISION DBLARR( KEEP8(26) )
      INTEGER INTARR( KEEP8(27) )
      LOGICAL IS_ISOLATED_NODE
      INTEGER LPN_LIST
      INTEGER PIVNUL_LIST(LPN_LIST)
      DOUBLE PRECISION DKEEP(230)
      INTEGER LRGROUPS(N)
      INTEGER, INTENT( IN ) :: LTPS_ARR
      TYPE (MUMPS_TPS_T), TARGET  :: MUMPS_TPS_ARR( LTPS_ARR )
      TYPE (DMUMPS_TPS_T), TARGET :: DMUMPS_TPS_ARR( LTPS_ARR )
      INTEGER, INTENT( IN ) :: LL0_OMP_MAPPING
      INTEGER, INTENT( IN ) :: L0_OMP_MAPPING( LL0_OMP_MAPPING )
      include 'mpif.h'
      include 'mumps_tags.h'
      INTEGER :: STATUS(MPI_STATUS_SIZE)
      INTEGER :: IERR
      DOUBLE PRECISION, PARAMETER :: DZERO = 0.0d0, done = 1.0d0
      INTEGER INODE
      INTEGER IWPOSCB
      INTEGER FPERE, TYPEF
      INTEGER MP, LP, DUMMY(1)
      INTEGER NBFIN, NBROOT_TRAITEES
      INTEGER NFRONT, IOLDPS, NASS, HF, XSIZE
      INTEGER(8) :: NFRONT8
      INTEGER(8) :: POSELT
      INTEGER IPOSROOT, IPOSROOTROWINDICES
      INTEGER GLOBK109
      INTEGER(8) :: LBUFRX
      DOUBLE PRECISION, POINTER, DIMENSION(:) :: BUFRX
      LOGICAL :: IS_BUFRX_ALLOCATED
      DOUBLE PRECISION FLOP1
      INTEGER TYPE
      LOGICAL SON_LEVEL2, SET_IRECV, BLOCKING,
     &        MESSAGE_RECEIVED
      LOGICAL AVOID_DELAYED
      LOGICAL LAST_CALL
      INTEGER MASTER_ROOT
      INTEGER LOCAL_M, LOCAL_N
      INTEGER LRHS_CNTR_MASTER_ROOT, FWD_LOCAL_N_RHS
      LOGICAL ROOT_OWNER
      EXTERNAL mumps_typenode, mumps_procnode
      INTEGER MUMPS_TYPENODE, MUMPS_PROCNODE
      LOGICAL MUMPS_INSSARBR,MUMPS_ROOTSSARBR
      EXTERNAL mumps_inssarbr,mumps_rootssarbr
      LOGICAL DMUMPS_POOL_EMPTY
      EXTERNAL dmumps_pool_empty, dmumps_extract_pool
      LOGICAL STACK_RIGHT_AUTHORIZED
      INTEGER numroc
      EXTERNAL numroc
      INTEGER JOBASS, ETATASS
      INTEGER(8) :: LAFAC
      INTEGER LIWFAC, STRAT, TYPEFile, NextPiv2beWritten,
     &        IDUMMY
      INTEGER(8) :: ITMP8
      TYPE(IO_BLOCK) :: MonBloc
      include 'mumps_headers.h'
      INTEGER MPA
      DOUBLE PRECISION  OPLAST_PRINTED
      INTEGER:: ITH
      DOUBLE PRECISION :: DUMMY_FLOP_ESTIM_ACC
#if defined(multicore_profiling)
      DOUBLE PRECISION :: LATIME, LFTIME, LSTIME
      DOUBLE PRECISION :: GATIME, GFTIME, GSTIME
      gatime = 0
      gftime = 0
      gstime = 0
#endif
      dummy_flop_estim_acc = 0.0d0
      itloc(1:n+keep(253)) =0
      ass_irecv = mpi_request_null
      mp = icntl(2)
      lp = icntl(1)
      iwposcb = liw
      NULLIFY(bufrx)
      is_bufrx_allocated = .false.
      keep(143) = -1
      IF ( info(1) .LT. 0 ) THEN
        GOTO 640
      ENDIF
      oplast_printed = done
      mpa            = icntl(2)
      IF (icntl(4).LT.2) mpa=0
      IF (mpa.GT.0)
     &   CALL mumps_print_still_active (myid_nodes, keep, 
     &                        dble(dkeep(17)), 
     &                        opeli,
     &                        oplast_printed, mpa)
      stack_right_authorized = .true.
      CALL dmumps_alloc_cb( .false., 0_8,
     &     .false., .false., myid_nodes, n, keep, keep8, dkeep,
     &     iw, liw, a, la, lrlu, iptrlu, iwpos, iwposcb,
     &     slavef, procnode_steps, dad,
     &     ptrist, ptrast, step, pimaster,
     &     pamaster, keep(ixsz), 0_8, -444, -444, .true.,
     &     comp, lrlus, keep8(67),
     &     info(1), info(2)
     &     )
      jobass  = 0
      etatass = 0
      nbfin = nbrtot
      nbroot_traitees = 0
      keep(121)=0
      IF ( keep(38).NE.0 ) THEN
        IF (root%yes) THEN
            CALL dmumps_root_alloc_static(
     &        root, keep(38), n, iw, liw,
     &        a, la,
     &        fils, dad, myid_nodes, slavef, procnode_steps,
     &        lptrar, nelt, frtptr, frtelt,
     &        ptraiw, ptrarw,
     &        intarr, dblarr,
     &        lrlu, iptrlu,
     &        iwpos, iwposcb, ptrist, ptrast,
     &        step, pimaster, pamaster, itloc, rhs_mumps,
     &        comp, lrlus, info(1), keep,keep8, dkeep, info(2) )
        ENDIF
        IF ( info(1) .LT. 0 ) GOTO 635
      END IF
      IF (keep(400).GT.0) THEN
        nbroot_traitees = nbroot_under_l0
        IF (nbroot_traitees .GT.0) THEN
          IF (nbroot_traitees.EQ.nbroot) THEN
            nbfin = nbfin - nbroot
            IF (slavef .GT. 1) THEN
               CALL dmumps_mcast2( nbroot, 1, mpi_integer,
     &         myid_nodes, comm_nodes, racine, slavef, keep )
            ENDIF
          ENDIF
        ENDIF
        IF (nbfin .EQ. 0) GOTO 640
      ENDIF
      keep(429)=0
 20   CONTINUE
      niv1_flag=0
      set_irecv = .true.
      blocking = .false.
      message_received = .false.
      CALL dmumps_try_recvtreat(
     &      comm_load, ass_irecv, blocking, set_irecv,
     &      message_received,
     &      mpi_any_source, mpi_any_tag,
     &      status, bufr, lbufr,
     &      lbufr_bytes, procnode_steps, posfac,
     &      iwpos, iwposcb, iptrlu,
     &      lrlu, lrlus, n, iw, liw, a, la,
     &      ptrist, ptlust, ptrfac,
     &      ptrast, step, pimaster, pamaster, nstk_steps,
     &      comp, info(1), info(2), comm_nodes, perm,
     &      ipool, lpool, leaf, nbfin, myid_nodes, slavef,
     &      root, opass, opeli, itloc, rhs_mumps, fils, dad,
     &      ptrarw, ptraiw,
     &      intarr, dblarr, icntl, keep,keep8,dkeep, nd, frere,
     &      lptrar, nelt, frtptr, frtelt,
     &      istep_to_iniv2, tab_pos_in_pere,
     &      stack_right_authorized
     &               , lrgroups
     &       )
      CALL dmumps_load_recv_msgs(comm_load)
      IF (mpa.GT.0)
     &   CALL mumps_print_still_active (myid_nodes, keep, 
     &                        dble(dkeep(17)), 
     &                        opeli,
     &                        oplast_printed, mpa)
      IF (message_received) THEN
          IF ( info(1) .LT. 0 ) GO TO 640
          IF ( nbfin .eq. 0 ) GOTO 640
      ELSE
          IF ( .NOT. dmumps_pool_empty( ipool, lpool) )THEN
            CALL dmumps_extract_pool( n, ipool, lpool,
     &      procnode_steps,
     &      slavef, step, inode, keep,keep8, myid_nodes, nd,
     &      (.NOT. stack_right_authorized) )
            stack_right_authorized = .true.
            IF (keep(47) .GE. 3) THEN
              CALL dmumps_load_pool_upd_new_pool(
     &              ipool, lpool,
     &              procnode_steps, keep,keep8, slavef, comm_load,
     &              myid_nodes, step, n, nd, fils )
            ENDIF
            IF (keep(47).EQ.4) THEN
               IF(inode.GT.0.AND.inode.LE.n)THEN
                  IF((ne(step(inode)).EQ.0).AND.
     &                 (frere(step(inode)).EQ.0))THEN
                     is_isolated_node=.true.
                  ELSE
                     is_isolated_node=.false.
                  ENDIF
               ENDIF
               CALL dmumps_load_sbtr_upd_new_pool(
     &              is_isolated_node,inode,ipool,lpool,
     &              myid_nodes,slavef,comm_load,keep,keep8)
            ENDIF
            IF ((( keep(80) == 2 .OR. keep(80)==3 ) .AND.
     &           ( keep(47) == 4 )).OR.
     &           (keep(80) == 1 .AND. keep(47) .GE. 1)) THEN
               CALL dmumps_upper_predict(inode,step,keep(28),
     &         procnode_steps,frere,nd,comm_load,slavef,
     &         myid_nodes,keep,keep8,n)
            END IF
            GOTO 30
          ENDIF
      ENDIF
      GO TO 20
 30   CONTINUE
      IF ( inode .LT. 0 ) THEN
        inode = -inode
        fpere = dad(step(inode))
        GOTO 130
      ELSE IF (inode.GT.n) THEN
       inode = inode - n
       IF (inode.EQ.keep(38)) THEN
         nbroot_traitees = nbroot_traitees + 1
         IF ( nbroot_traitees .EQ. nbroot ) THEN
            nbfin = nbfin - nbroot
            IF (slavef.GT.1) THEN
                dummy(1) = nbroot
                CALL dmumps_mcast2(dummy, 1, mpi_integer, myid_nodes,
     &          comm_nodes, racine, slavef, keep )
            END IF
         ENDIF
         IF (nbfin.EQ.0) GOTO 640
         GOTO 20
       ENDIF
       TYPE = mumps_typenode(procnode_steps(step(inode)),keep(199))
       IF (type.EQ.1) GOTO 100
       fpere = dad(step(inode))
       avoid_delayed = ( (fpere .eq. keep(20) .OR. fpere .eq. keep(38))
     &                   .AND. keep(60).ne.0 )
       IF ( keep(50) .eq. 0 ) THEN
         CALL  dmumps_fac2_lu( comm_load, ass_irecv,
     &        n, inode, fpere, iw, liw, a, la, uu,
     &        noffnegpv, ntotpv, nbtiny,
     &        det_exp, det_mant, det_sign,
     &        comm_nodes, myid_nodes, bufr, lbufr,lbufr_bytes,
     &        nbfin,leaf, info(1), info(2), ipool,lpool,
     &        slavef, posfac, iwpos, iwposcb, iptrlu, lrlu,
     &        lrlus, comp, ptrist, ptrast, ptlust, ptrfac,
     &        step, pimaster, pamaster,
     &        nstk_steps,perm,procnode_steps,
     &        root, opass, opeli, itloc, rhs_mumps,
     &        fils, dad, ptrarw, ptraiw,
     &        intarr, dblarr, icntl, keep,keep8, nd, frere,
     &        lptrar, nelt, frtptr, frtelt, seuil,
     &        istep_to_iniv2, tab_pos_in_pere, avoid_delayed,
     &        dkeep(1),pivnul_list(1),lpn_list
     &        , lrgroups
     &             )
        IF ( info(1) .LT. 0 ) GOTO 640
        IF (mpa.GT.0)
     &   CALL mumps_print_still_active (myid_nodes, keep, 
     &                        dble(dkeep(17)), 
     &                        opeli,
     &                        oplast_printed, mpa)
       ELSE
         CALL dmumps_fac2_ldlt( comm_load, ass_irecv,
     &             n, inode, fpere, iw, liw, a, la, uu,
     &             noffnegpv, ntotpv,
     &             nb22t2, nbtiny, det_exp, det_mant, det_sign,
     &             comm_nodes, myid_nodes, bufr, lbufr,lbufr_bytes,
     &             nbfin,leaf, info(1), info(2), ipool,lpool,
     &             slavef, posfac, iwpos, iwposcb, iptrlu, lrlu,
     &             lrlus, comp, ptrist, ptrast, ptlust, ptrfac,
     &             step, pimaster, pamaster,
     &             nstk_steps,perm,procnode_steps,
     &             root, opass, opeli, itloc, rhs_mumps,
     &             fils, dad, ptrarw, ptraiw,
     &             intarr, dblarr, icntl, keep,keep8, nd, frere,
     &             lptrar, nelt, frtptr, frtelt, seuil_ldlt_niv2,
     &             istep_to_iniv2, tab_pos_in_pere, avoid_delayed,
     &              dkeep(1),pivnul_list(1),lpn_list
     &           , lrgroups
     &             )
        IF ( info(1) .LT. 0 ) GOTO 640
        IF (mpa.GT.0)
     &   CALL mumps_print_still_active (myid_nodes, keep, 
     &                        dble(dkeep(17)), 
     &                        opeli,
     &                        oplast_printed, mpa)
        IF ( iw( ptlust(step(inode)) + keep(ixsz) + 5 ) .GT. 1 ) THEN
             GOTO 20
        END IF
       END IF
       GOTO 130
      ENDIF
      IF (inode.EQ.keep(38)) THEN
         CALL  dmumps_last_rtnelind( comm_load, ass_irecv,
     &    root, frere,
     &    inode,
     &    bufr, lbufr, lbufr_bytes, procnode_steps, posfac,
     &    iwpos, iwposcb, iptrlu,
     &    lrlu, lrlus, n, iw, liw, a, la, ptrist,
     &    ptlust, ptrfac,
     &    ptrast, step, pimaster, pamaster, nstk_steps, comp,
     &    info(1), info(2), comm_nodes,
     &    perm,
     &    ipool, lpool, leaf,
     &    nbfin, myid_nodes, slavef,
     &
     &    opass, opeli, itloc, rhs_mumps,
     &    fils, dad, ptrarw, ptraiw,
     &    intarr, dblarr,icntl,keep,keep8,dkeep, nd,
     &    lptrar, nelt, frtptr, frtelt,
     &    istep_to_iniv2, tab_pos_in_pere
     &               , lrgroups
     &      )
         IF ( info(1) .LT. 0 ) GOTO 640
         IF (mpa.GT.0)
     &   CALL mumps_print_still_active (myid_nodes, keep, 
     &                        dble(dkeep(17)), 
     &                        opeli,
     &                        oplast_printed, mpa)
        GOTO 20
      ENDIF
      TYPE = mumps_typenode(procnode_steps(step(inode)),keep(199))
      IF (type.EQ.1) THEN
        IF (keep(55).NE.0) THEN
         CALL dmumps_fac_asm_niv1_elt( comm_load, ass_irecv,
     &        nelt, frtptr, frtelt,
     &        n,inode,iw,liw,a,la,
     &        info(1),nd,
     &        fils,frere,dad,maxfrt,root,opass, opeli,
     &     ptrist,ptlust,ptrfac,ptrast,step, pimaster,pamaster,
     &        ptrarw,ptraiw,
     &        itloc, rhs_mumps, nstepsdone, son_level2,
     &        comp, lrlu, iptrlu,
     &        iwpos,iwposcb, posfac, lrlus, keep8(67),
     &        icntl, keep,keep8,dkeep,
     &        intarr,keep8(27),dblarr,keep8(26),
     &    nstk_steps,procnode_steps, slavef,
     &    comm_nodes, myid_nodes,
     &    bufr, lbufr, lbufr_bytes, nbfin, ipool, lpool, leaf,
     &    perm, istep_to_iniv2, tab_pos_in_pere
     &               , lrgroups
     &    , mumps_tps_arr, dmumps_tps_arr,
     &    l0_omp_mapping
     &    )
        ELSE
         jobass = 0
         CALL dmumps_fac_asm_niv1(comm_load, ass_irecv,
     &        n,inode,iw,liw,a,la,
     &        info(1),nd,
     &        fils,frere,dad,maxfrt,root,opass, opeli,
     &      ptrist,ptlust,ptrfac,ptrast,step, pimaster,pamaster,
     &        ptrarw,ptraiw,
     &        itloc, rhs_mumps, nstepsdone, son_level2,
     &        comp, lrlu, iptrlu,
     &        iwpos,iwposcb, posfac, lrlus, keep8(67),
     &        icntl, keep,keep8,dkeep, intarr,keep8(27),
     &        dblarr,keep8(26),
     &    nstk_steps,procnode_steps, slavef,
     &    comm_nodes, myid_nodes,
     &    bufr, lbufr, lbufr_bytes, nbfin, ipool, lpool, leaf,
     &    perm,
     &    istep_to_iniv2, tab_pos_in_pere, jobass,etatass
     &               , lrgroups
     &    , mumps_tps_arr, dmumps_tps_arr,
     &    l0_omp_mapping
     &    )
        ENDIF
        IF (mpa.GT.0)
     &   CALL mumps_print_still_active (myid_nodes, keep, 
     &                        dble(dkeep(17)), 
     &                        opeli,
     &                        oplast_printed, mpa)
       IF ( info(1) .LT. 0 ) GOTO 640
        IF ((iw(ptlust(step(inode))+xxnbpr).GT.0).OR.(son_level2)) THEN
          GOTO 20
        ENDIF
      ELSE
        IF ( keep(55) .eq. 0 ) THEN
          CALL dmumps_fac_asm_niv2(comm_load, ass_irecv,
     &    n, inode, iw, liw, a, la,
     &    info(1),
     &    nd, fils, frere, dad, cand,
     &    istep_to_iniv2, tab_pos_in_pere,
     &    maxfrt,
     &    root, opass, opeli, ptrist, ptlust, ptrfac,
     &    ptrast, step, pimaster, pamaster, ptrarw, nstk_steps,
     &    ptraiw, itloc, rhs_mumps, nstepsdone,
     &    comp, lrlu, iptrlu, iwpos, iwposcb, posfac, lrlus,
     &    icntl, keep,keep8,dkeep,intarr,keep8(27),dblarr,keep8(26),
     &    procnode_steps, slavef, comm_nodes,
     &    myid_nodes,
     &    bufr, lbufr, lbufr_bytes,
     &    nbfin, leaf, ipool, lpool, perm,
     &    mem_distrib(0)
     &               , lrgroups
     &    )
        ELSE
          CALL dmumps_fac_asm_niv2_elt( comm_load, ass_irecv,
     &    nelt, frtptr, frtelt,
     &    n, inode, iw, liw, a, la, info(1),
     &    nd, fils, frere, dad, cand,
     &    istep_to_iniv2, tab_pos_in_pere,
     &    maxfrt,
     &    root, opass, opeli, ptrist, ptlust, ptrfac,
     &    ptrast, step, pimaster, pamaster, ptrarw, nstk_steps,
     &    ptraiw, itloc, rhs_mumps, nstepsdone,
     &    comp, lrlu, iptrlu, iwpos, iwposcb, posfac, lrlus,
     &    icntl, keep,keep8,dkeep,intarr,keep8(27),dblarr,keep8(26),
     &    procnode_steps, slavef, comm_nodes,
     &    myid_nodes,
     &    bufr, lbufr, lbufr_bytes,
     &    nbfin, leaf, ipool, lpool, perm,
     &    mem_distrib(0)
     &               , lrgroups
     &     )
        END IF
        IF (mpa.GT.0)
     &   CALL mumps_print_still_active (myid_nodes, keep, 
     &                        dble(dkeep(17)), 
     &                        opeli,
     &                        oplast_printed, mpa)
        IF (info(1).LT.0) GOTO 640
        GOTO 20
      ENDIF
 100  CONTINUE
       fpere = dad(step(inode))
      IF ( inode .eq. keep(20) ) THEN
        poselt = ptrast(step(inode))
        IF (ptrfac(step(inode)).NE.poselt) THEN
          WRITE(*,*) "ERROR 2 in DMUMPS_FAC_PAR", poselt
          GOTO 635
        ENDIF
        CALL dmumps_change_header
     &       ( iw(ptlust(step(inode))+keep(ixsz)), keep(253) )
        GOTO 200
      END IF
      poselt = ptrast(step(inode))
      ioldps = ptlust(step(inode))
      xsize =  keep(ixsz)
      hf = 6 + iw(ioldps+5+xsize)+xsize
      nfront = iw(ioldps+xsize) 
      nass   = iabs(iw(ioldps+2+xsize))
      avoid_delayed = ( (fpere .eq. keep(20) .OR. fpere .eq. keep(38))
     &                   .AND. keep(60).ne.0 )
      IF (keep(50).EQ.0) THEN
           CALL dmumps_fac1_lu ( 
     &               n, inode, iw, liw, a, la,
     &               ioldps, poselt,
     &               info(1), info(2), uu, noffnegpv, ntotpv, nbtiny,
     &               det_exp, det_mant, det_sign,
     &               keep,keep8,
     &               step, procnode_steps, myid_nodes, slavef,
     &               seuil, avoid_delayed, etatass,
     &              dkeep(1),pivnul_list(1),lpn_list, iwpos 
     &           , lrgroups
     &           , perm
     &           )
           IF (info(1).LT.0) GOTO 635
#if defined(multicore_profiling)
         lftime = mpi_wtime() - lftime
         gftime = gftime + lftime
         WRITE(*,*)'FAC ',lftime
#endif
      ELSE  
            iw( ioldps+4+keep(ixsz) ) = 1
              CALL dmumps_fac1_ldlt( n, inode,
     &           iw, liw, a, la,
     &           ioldps, poselt,
     &           info(1), info(2), uu, noffnegpv, ntotpv,
     &           nb22t1, nbtiny, det_exp, det_mant, det_sign,
     &           keep,keep8, myid_nodes, seuil, avoid_delayed,
     &           etatass,
     &           dkeep(1),pivnul_list(1),lpn_list, iwpos
     &           , lrgroups
     &           , perm
     &           )
             IF (info(1).LT.0) GOTO 635
            iw( ioldps+4+keep(ixsz) ) = step(inode)
          ENDIF 
          jobass = etatass          
          IF (jobass.EQ.1) THEN
#if defined(multicore_profiling)
              latime = mpi_wtime()
#endif
              CALL dmumps_fac_asm_niv1(comm_load, ass_irecv,
     &        n,inode,iw,liw,a,la,
     &        info(1),nd,
     &        fils,frere,dad,maxfrt,root,opass, opeli,
     &        ptrist,ptlust,ptrfac,ptrast,step,pimaster,pamaster,
     &        ptrarw,ptraiw,
     &        itloc, rhs_mumps, nstepsdone, son_level2,
     &        comp, lrlu, iptrlu,
     &        iwpos,iwposcb, posfac, lrlus, keep8(67),
     &        icntl, keep,keep8,dkeep,intarr,keep8(27),dblarr,keep8(26),
     &        nstk_steps, procnode_steps, slavef,
     &        comm_nodes, myid_nodes,
     &        bufr, lbufr, lbufr_bytes, nbfin, ipool, lpool, leaf,
     &        perm,
     &        istep_to_iniv2, tab_pos_in_pere,
     &        jobass,etatass
     &               , lrgroups
     &         )
#if defined(multicore_profiling)
         latime = mpi_wtime() - latime
         gatime = gatime + latime
         WRITE(*,*)'ASS ',latime
#endif
          ENDIF
          IF (mpa.GT.0)
     &    CALL mumps_print_still_active (myid_nodes, keep, 
     &                        dble(dkeep(17)), 
     &                        opeli,
     &                        oplast_printed, mpa)
      IF (info(1).LT.0) GOTO 635
 130  CONTINUE
      TYPE  = mumps_typenode(procnode_steps(step(inode)),keep(199))
      IF ( fpere .NE. 0 ) THEN
        typef = mumps_typenode(procnode_steps(step(fpere)),keep(199))
      ELSE
        typef = -9999
      END IF
#if defined(multicore_profiling)
         lstime = mpi_wtime()
#endif
      CALL dmumps_fac_stack( comm_load, ass_irecv,
     &       n,inode,TYPE,TYPEF,LA,IW,LIW,A,
     &       INFO(1),INFO(2),OPELI,NELVA,NMAXNPIV,
     &       PTRIST,PTLUST,PTRFAC,
     &       PTRAST, STEP, PIMASTER, PAMASTER,
     &       NE, POSFAC,LRLU, LRLUS,KEEP8(67),
     &       IPTRLU,ICNTL,KEEP,KEEP8,DKEEP,COMP,IWPOS,IWPOSCB,
     &       PROCNODE_STEPS,SLAVEF,FPERE,COMM_NODES,MYID_NODES,
     &       IPOOL, LPOOL, LEAF,
     &       NSTK_STEPS, PERM, BUFR, LBUFR, LBUFR_BYTES, NBFIN,
     &       root, OPASS, ITLOC, RHS_MUMPS, FILS, DAD, PTRARW, PTRAIW,
     &       INTARR, DBLARR,
     &       ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT,
     &       ISTEP_TO_INIV2, TAB_POS_IN_PERE
     &               , LRGROUPS
     &       ,DUMMY_FLOP_ESTIM_ACC
     &       )
#if defined(multicore_profiling)
         lstime = mpi_wtime() - lstime
         gstime = gstime + lstime
         WRITE(*,*)'STK ',lstime
#endif
      IF (mpa.GT.0)
     &   CALL mumps_print_still_active (myid_nodes, keep, 
     &                        dble(dkeep(17)), 
     &                        opeli,
     &                        oplast_printed, mpa)
      IF (info(1).LT.0) GOTO 640
 200  CONTINUE
      IF ( inode .eq. keep(38) ) THEN
        WRITE(*,*) 'Error .. in DMUMPS_FAC_PAR: ',
     &             ' INODE == KEEP(38)'
        CALL mumps_abort()
      END IF
      IF ( fpere.EQ.0 ) THEN
        nbroot_traitees = nbroot_traitees + 1
        IF ( nbroot_traitees .EQ. nbroot ) THEN
           IF (keep(201).EQ.1) THEN 
              CALL dmumps_ooc_force_wrt_buf_panel(ierr)
           ELSE IF ( keep(201).EQ.2) THEN 
              CALL dmumps_force_write_buf(ierr)
           ENDIF
            nbfin = nbfin - nbroot
            IF ( nbfin .LT. 0 ) THEN
              WRITE(*,*) ' ERROR 1 in DMUMPS_FAC_PAR: ',
     &                   ' NBFIN=', nbfin
              CALL mumps_abort()
            END IF
            IF ( nbroot .LT. 0 ) THEN
              WRITE(*,*) ' ERROR 1 in DMUMPS_FAC_PAR: ',
     &                   ' NBROOT=', nbroot
              CALL mumps_abort()
            END IF
            IF (slavef.GT.1) THEN
                dummy(1) = nbroot
                CALL dmumps_mcast2( dummy(1), 1, mpi_integer,
     &          myid_nodes, comm_nodes, racine, slavef, keep )
            END IF
        ENDIF
        IF (nbfin.EQ.0)THEN
           GOTO 640
        ENDIF
      ELSEIF ( fpere.NE.keep(38) .AND.
     &         mumps_procnode(procnode_steps(step(fpere)),
     &         keep(199)) .EQ.  myid_nodes ) THEN
        nstk_steps(step(fpere)) = nstk_steps(step(fpere))-1
        IF ( nstk_steps( step( fpere )).EQ.0) THEN
          IF (keep(234).NE.0 .AND.
     &      mumps_inssarbr(procnode_steps(step(inode)),keep(199)))
     &      THEN
            stack_right_authorized = .false.
          ENDIF
          CALL dmumps_insert_pool_n(n, ipool, lpool,
     &         procnode_steps, slavef, keep(199), keep(28), keep(76),
     &         keep(80), keep(47), step, fpere )
          IF (keep(47) .GE. 3) THEN
             CALL dmumps_load_pool_upd_new_pool(
     &            ipool, lpool,
     &            procnode_steps, keep,keep8, slavef, comm_load,
     &            myid_nodes, step, n, nd, fils )
          ENDIF
          CALL mumps_estim_flops( fpere, n, procnode_steps,keep(199),
     &           nd, fils, frere, step, pimaster, keep(28),
     &           keep(50), keep(253), flop1,
     &           iw, liw, keep(ixsz) )
          IF (fpere.NE.keep(20))
     &    CALL dmumps_load_update(1,.false.,flop1,keep,keep8)
        ENDIF
      ENDIF
      GO TO 20
 635  CONTINUE
      CALL dmumps_bdc_error( myid_nodes, slavef, comm_nodes, keep )
 640  CONTINUE
        CALL dmumps_cancel_irecv( info(1),
     &       keep,
     &       ass_irecv, bufr, lbufr,
     &       lbufr_bytes,
     &       comm_nodes,
     &       myid_nodes, slavef)
       CALL dmumps_clean_pending( info(1), keep,
     &      bufr, lbufr,
     &      lbufr_bytes,
     &      comm_nodes, comm_load, slavef,
     &      .true.,
     &      .true.)
      CALL mpi_barrier( comm_nodes, ierr )
      IF (info(1) .LT. 0) THEN
        CALL dmumps_dm_freealldynamiccb( myid, n, slavef, keep, keep8,
     &  iw, liw, iwposcb, iwpos,
     &  step, ptrast, pamaster, procnode_steps, dad,
     &  .false. ) 
        IF (keep(400) .GT. 0) THEN
!$OMP PARALLEL DO SCHEDULE(STATIC,1)
            DO ith = 1, keep(400)
              IF (associated(mumps_tps_arr(ith)%IW)) THEN
                CALL dmumps_dm_freealldynamiccb_i( myid, n, slavef,
     &          keep, keep8,
     &          mumps_tps_arr(ith)%IW(1), mumps_tps_arr(ith)%LIW,
     &          mumps_tps_arr(ith)%IWPOSCB, mumps_tps_arr(ith)%IWPOS,
     &          step, ptrast, pamaster, procnode_steps, dad,
     &          .true. ) 
              ENDIF
            ENDDO
!$OMP END PARALLEL DO
        ENDIF
      ENDIF
      IF ( info(1) .GE. 0 ) THEN
          IF( keep(38) .NE. 0 .OR. keep(20).NE.0) THEN
            master_root = mumps_procnode(
     &                  procnode_steps(step(max(keep(38),keep(20)))),
     &                  keep(199))
            root_owner  = (master_root .EQ. myid_nodes)
            IF ( keep(38) .NE. 0 ) THEN
               IF (keep(60).EQ.0) THEN
                 ioldps  = ptlust(step(keep(38)))
                 local_m = iw(ioldps+2+keep(ixsz))
                 local_n = iw(ioldps+1+keep(ixsz))
               ELSE
                 ioldps  = -999
                 local_m = root%SCHUR_MLOC
                 local_n = root%SCHUR_NLOC
               ENDIF
               itmp8   = int(local_m,8)*int(local_n,8)
               lbufrx = min(int(root%MBLOCK,8)*int(root%NBLOCK,8),
     &            int(root%TOT_ROOT_SIZE,8)*int(root%TOT_ROOT_SIZE,8) )
               is_bufrx_allocated = .false.
               IF ( lrlu .GT. lbufrx ) THEN
                   bufrx => a(posfac:posfac+lrlu-1_8)
                   lbufrx=lrlu
               ELSE
                   ALLOCATE( bufrx( lbufrx ), stat = ierr )
                   IF (ierr.gt.0) THEN
                         info(1) = -13
                         CALL mumps_set_ierror(lbufrx, info(2) )
                         IF (lp > 0 )
     &                   write(lp,*) ' Error allocating, real array ',
     &                   'of size before DMUMPS_FACTO_ROOT',  lbufrx
                         CALL mumps_abort()
                   ENDIF
                   is_bufrx_allocated = .true.
               ENDIF
               CALL dmumps_facto_root( 
     &               mpa, myid_nodes, master_root,
     &               root, n, keep(38),
     &               comm_nodes, iw, liw, iwpos + 1,
     &               a, la, ptrast, ptlust, ptrfac, step,
     &               info(1), keep(50), keep(19),
     &               bufrx(1), lbufrx, keep,keep8, dkeep,
     &               opeli, det_exp, det_mant, det_sign )
               IF (is_bufrx_allocated) DEALLOCATE ( bufrx )
               NULLIFY(bufrx)
               is_bufrx_allocated = .false.
                IF ( myid_nodes .eq. 
     &               mumps_procnode(procnode_steps(step(keep(38))),
     &                              keep(199))
     &             ) THEN
                   IF ( info(1) .EQ. -10 .OR. info(1) .EQ. -40 ) THEN
                      ntotpv = ntotpv + info(2)
                   ELSE
                      ntotpv = ntotpv + root%TOT_ROOT_SIZE
                      nmaxnpiv = max(nmaxnpiv,root%TOT_ROOT_SIZE)
                   END IF
                END IF
                IF (root%yes.AND.keep(60).EQ.0) THEN
                  IF (keep(252).EQ.0) THEN
                  IF (keep(201).EQ.1) THEN 
                    CALL mumps_geti8(lafac, iw(ioldps+xxr))
                    liwfac    = iw(ioldps+xxi)
                    typefile  = typef_l
                    nextpiv2bewritten = 1 
                    monbloc%INODE    = keep(38)   
                    monbloc%MASTER   = .true.
                    monbloc%Typenode = 3
                    monbloc%NROW     = local_m
                    monbloc%NCOL     = local_n
                    monbloc%NFS      = monbloc%NCOL
                    monbloc%Last     = .true.   
                    monbloc%LastPiv  =  monbloc%NCOL
                    monbloc%LastPanelWritten_L=-9999 
                    monbloc%LastPanelWritten_U=-9999 
                    NULLIFY(monbloc%INDICES)
                    strat        = strat_write_max
                    monbloc%Last = .true.
                    last_call = .true.
                    CALL dmumps_ooc_io_lu_panel
     &                                 ( strat, typefile,
     &                                  a(ptrfac(step(keep(38)))),
     &                                  lafac, monbloc,
     &                                  nextpiv2bewritten, idummy,
     &                                  iw(ioldps), liwfac,
     &                                  myid, keep8(31), ierr,last_call)
                  ELSE IF (keep(201).EQ.2) THEN
                    keep8(31)=keep8(31)+ itmp8
                    CALL dmumps_new_factor(keep(38),ptrfac,
     &              keep,keep8,a,la, itmp8, ierr)
                    IF(ierr.LT.0)THEN
                      WRITE(*,*)myid,
     &                ': Internal error in DMUMPS_NEW_FACTOR'
                      CALL mumps_abort()
                    ENDIF
                  ENDIF 
                  ENDIF 
                  IF (keep(201).NE.0 .OR. keep(252).NE.0) THEN
                     lrlus = lrlus + itmp8 
                     keep8(69) = keep8(69) - itmp8 
                     IF (keep(252).NE.0) THEN
                       CALL dmumps_load_mem_update(.false.,.false.,
     &                 la-lrlus
     &                 ,0_8,-itmp8,
     &                 keep,keep8,lrlus)
                     ELSE         
                       CALL dmumps_load_mem_update(.false.,.false.,
     &                 la-lrlus
     &                 ,itmp8,    
     &                 0_8,
     &                 keep,keep8,lrlus)
                     ENDIF
                     IF (ptrfac(step(keep(38))).EQ.posfac-itmp8) THEN
                       posfac = posfac  - itmp8
                       lrlu   = lrlu    + itmp8
                     ENDIF
                  ELSE
                       CALL dmumps_load_mem_update(.false.,.false.,
     &                 la-lrlus
     &                 ,itmp8,    
     &                 0_8,
     &                 keep,keep8,lrlus)
                  ENDIF
                ENDIF  
                IF (root%yes. and. keep(252) .NE. 0 .AND.
     &              (keep(60).EQ.0 .OR. keep(221).EQ.1)) THEN
                  IF (myid_nodes .EQ. master_root) THEN
                    lrhs_cntr_master_root = root%TOT_ROOT_SIZE*keep(253)
                  ELSE
                    lrhs_cntr_master_root = 1
                  ENDIF
                  ALLOCATE(root%RHS_CNTR_MASTER_ROOT( 
     &                     lrhs_cntr_master_root), stat=ierr )
                  IF (ierr.gt.0) THEN
                    info(1) = -13
                    info(2) = lrhs_cntr_master_root
                    IF (lp > 0 )
     &              write(lp,*) ' Error allocating, real array ',
     &              'of size before DMUMPS_FACTO_ROOT',
     &              lrhs_cntr_master_root
                    CALL mumps_abort()
                  ENDIF
                  fwd_local_n_rhs = numroc(keep(253), root%NBLOCK,
     &            root%MYCOL, 0, root%NPCOL)
                  fwd_local_n_rhs = max(1,fwd_local_n_rhs)
                  CALL dmumps_gather_root( myid_nodes,
     &            root%TOT_ROOT_SIZE, keep(253),
     &            root%RHS_CNTR_MASTER_ROOT(1), local_m,
     &            fwd_local_n_rhs, root%MBLOCK, root%NBLOCK,
     &            root%RHS_ROOT(1,1), master_root,
     &            root%NPROW, root%NPCOL, comm_nodes )
     &             
                ENDIF
            ELSE
                IF (keep(19).NE.0) THEN
                  CALL mpi_reduce(keep(109), globk109, 1,
     &                 mpi_integer, mpi_sum,
     &                 master_root,
     &                 comm_nodes, ierr)
                ENDIF
                IF (root_owner) THEN
                   iposroot = ptlust(step(keep(20)))
                   nfront   = iw(iposroot+keep(ixsz)+3)   
                   nfront8  = int(nfront,8)
                   iposrootrowindices=iposroot+6+keep(ixsz)+ 
     &                             iw(iposroot+5+keep(ixsz)) 
                   ntotpv = ntotpv + nfront 
                   nmaxnpiv = max(nmaxnpiv,nfront)
                END IF
                IF (root_owner.AND.keep(60).NE.0) THEN 
                  itmp8 = nfront8*nfront8
                  IF ( ptrfac(step(keep(20))) .EQ. posfac -
     &                 itmp8 ) THEN
                    posfac = posfac - itmp8
                    lrlus  = lrlus  + itmp8
                    lrlu   = lrlus  + itmp8
                    keep8(69) = keep8(69) - itmp8
                    CALL dmumps_load_mem_update(.false.,.false.,
     &              la-lrlus,0_8,-itmp8,keep,keep8,lrlus)
                  ENDIF
                ENDIF
            END IF
            IF (info(1).LT.0) GOTO 500
          END IF  
       END IF 
 500   CONTINUE
       IF ( keep(38) .NE. 0 ) THEN
         IF (myid_nodes.EQ. 
     &        mumps_procnode(procnode_steps(step(keep(38))),keep(199))
     &      ) THEN
           maxfrt = max( maxfrt, root%TOT_ROOT_SIZE)
         END IF
       END IF
      RETURN