cmumps_fac_par_m Module Reference

Functions/Subroutines
subroutine	cmumps_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, cmumps_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	cmumps_change_header (header, keep253)

Function/Subroutine Documentation

cmumps_change_header()

subroutine cmumps_fac_par_m::cmumps_change_header	(	integer, dimension( 6 )	header,
		integer	keep253 )

Definition at line 925 of file cfac_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

cmumps_fac_par()

subroutine cmumps_fac_par_m::cmumps_fac_par	(	integer	n,
		integer, dimension(liw)	iw,
		integer	liw,
		complex, 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,
		complex, 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,
		complex, 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 (cmumps_tps_t), dimension( ltps_arr ), target	cmumps_tps_arr,
		integer, intent(in)	ltps_arr,
		real, 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,
		real	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,
		complex, dimension( keep8(26) )	dblarr,
		type (cmumps_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,
		real	seuil,
		real	seuil_ldlt_niv2,
		integer, dimension(0: slavef - 1)	mem_distrib,
		integer, dimension(keep(28))	ne,
		real, dimension(230)	dkeep,
		integer, dimension(lpn_list)	pivnul_list,
		integer	lpn_list,
		integer, dimension(n)	lrgroups )

Definition at line 16 of file cfac_par_m.F.

!$    USE OMP_LIB
      USE cmumps_dynamic_memory_m, ONLY : 
     &                                    cmumps_dm_freealldynamiccb
      USE cmumps_load
      USE cmumps_ooc
      USE cmumps_fac_asm_master_m
      USE cmumps_fac_asm_master_elt_m
      USE cmumps_fac1_ldlt_m
      USE cmumps_fac2_ldlt_m
      USE cmumps_fac1_lu_m
      USE cmumps_fac2_lu_m
      USE omp_lib
      USE mumps_tps_m
      USE cmumps_tps_m
      USE cmumps_struc_def, ONLY : cmumps_root_struc
      IMPLICIT NONE
      TYPE (CMUMPS_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
      COMPLEX, INTENT(INOUT) :: DET_MANT
      INTEGER(8) :: LA
      COMPLEX, 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))
      COMPLEX :: 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))
      REAL 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
      REAL UU, SEUIL, SEUIL_LDLT_NIV2
      INTEGER NELT
      INTEGER FRTPTR( N+1 ), FRTELT( NELT )
      INTEGER LBUFR, LBUFR_BYTES
      INTEGER BUFR( LBUFR )
      COMPLEX DBLARR( KEEP8(26) )
      INTEGER INTARR( KEEP8(27) )
      LOGICAL IS_ISOLATED_NODE
      INTEGER LPN_LIST
      INTEGER PIVNUL_LIST(LPN_LIST)
      REAL DKEEP(230)
      INTEGER LRGROUPS(N)
      INTEGER, INTENT( IN ) :: LTPS_ARR
      TYPE (MUMPS_TPS_T), TARGET  :: MUMPS_TPS_ARR( LTPS_ARR )
      TYPE (CMUMPS_TPS_T), TARGET :: CMUMPS_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
      COMPLEX, 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 CMUMPS_POOL_EMPTY
      EXTERNAL cmumps_pool_empty, cmumps_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 cmumps_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 cmumps_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 cmumps_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 cmumps_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 cmumps_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. cmumps_pool_empty( ipool, lpool) )THEN
            CALL cmumps_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 cmumps_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 cmumps_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 cmumps_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 cmumps_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  cmumps_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 cmumps_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  cmumps_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 cmumps_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, cmumps_tps_arr,
     &    l0_omp_mapping
     &    )
        ELSE
         jobass = 0
         CALL cmumps_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, cmumps_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 cmumps_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 cmumps_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 CMUMPS_FAC_PAR", poselt
          GOTO 635
        ENDIF
        CALL cmumps_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 cmumps_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 cmumps_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 cmumps_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 cmumps_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 CMUMPS_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 cmumps_ooc_force_wrt_buf_panel(ierr)
           ELSE IF ( keep(201).EQ.2) THEN 
              CALL cmumps_force_write_buf(ierr)
           ENDIF
            nbfin = nbfin - nbroot
            IF ( nbfin .LT. 0 ) THEN
              WRITE(*,*) ' ERROR 1 in CMUMPS_FAC_PAR: ',
     &                   ' NBFIN=', nbfin
              CALL mumps_abort()
            END IF
            IF ( nbroot .LT. 0 ) THEN
              WRITE(*,*) ' ERROR 1 in CMUMPS_FAC_PAR: ',
     &                   ' NBROOT=', nbroot
              CALL mumps_abort()
            END IF
            IF (slavef.GT.1) THEN
                dummy(1) = nbroot
                CALL cmumps_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 cmumps_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 cmumps_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 cmumps_load_update(1,.false.,flop1,keep,keep8)
        ENDIF
      ENDIF
      GO TO 20
 635  CONTINUE
      CALL cmumps_bdc_error( myid_nodes, slavef, comm_nodes, keep )
 640  CONTINUE
        CALL cmumps_cancel_irecv( info(1),
     &       keep,
     &       ass_irecv, bufr, lbufr,
     &       lbufr_bytes,
     &       comm_nodes,
     &       myid_nodes, slavef)
       CALL cmumps_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 cmumps_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 cmumps_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 CMUMPS_FACTO_ROOT',  lbufrx
                         CALL mumps_abort()
                   ENDIF
                   is_bufrx_allocated = .true.
               ENDIF
               CALL cmumps_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 cmumps_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 cmumps_new_factor(keep(38),ptrfac,
     &              keep,keep8,a,la, itmp8, ierr)
                    IF(ierr.LT.0)THEN
                      WRITE(*,*)myid,
     &                ': Internal error in CMUMPS_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 cmumps_load_mem_update(.false.,.false.,
     &                 la-lrlus
     &                 ,0_8,-itmp8,
     &                 keep,keep8,lrlus)
                     ELSE         
                       CALL cmumps_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 cmumps_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 CMUMPS_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 cmumps_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 cmumps_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