dfac_process_rtnelind.F File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	dmumps_process_rtnelind (root, inode, nelim, nslaves, row_list, col_list, slave_list, procnode_steps, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust_s, ptrfac, ptrast, step, pimaster, pamaster, nstk_s, itloc, rhs_mumps, comp, iflag, ierror, ipool, lpool, leaf, myid, slavef, keep, keep8, dkeep, comm, comm_load, fils, dad, nd)

Function/Subroutine Documentation

dmumps_process_rtnelind()

subroutine dmumps_process_rtnelind	(	type (dmumps_root_struc)	root,
		integer	inode,
		integer	nelim,
		integer	nslaves,
		integer, dimension(*)	row_list,
		integer, dimension(*)	col_list,
		integer, dimension(*)	slave_list,
		integer, dimension( keep(28) )	procnode_steps,
		integer	iwpos,
		integer	iwposcb,
		integer(8)	iptrlu,
		integer(8)	lrlu,
		integer(8)	lrlus,
		integer	n,
		integer, dimension( liw )	iw,
		integer	liw,
		double precision, dimension( la )	a,
		integer(8)	la,
		integer, dimension( keep(28) )	ptrist,
		integer, dimension(keep(28))	ptlust_s,
		integer(8), dimension(keep(28))	ptrfac,
		integer(8), dimension(keep(28))	ptrast,
		integer, dimension(n)	step,
		integer, dimension(keep(28))	pimaster,
		integer(8), dimension(keep(28))	pamaster,
		integer, dimension(keep(28))	nstk_s,
		integer, dimension( n + keep(253) )	itloc,
		double precision, dimension(keep(255))	rhs_mumps,
		integer	comp,
		integer	iflag,
		integer	ierror,
		integer, dimension( lpool )	ipool,
		integer	lpool,
		integer	leaf,
		integer	myid,
		integer	slavef,
		integer, dimension( 500 )	keep,
		integer(8), dimension(150)	keep8,
		double precision, dimension(230)	dkeep,
		integer	comm,
		integer	comm_load,
		integer, dimension(n)	fils,
		integer, dimension(keep(28))	dad,
		integer, dimension(keep(28))	nd )

Definition at line 14 of file dfac_process_rtnelind.F.

      USE dmumps_load
      USE dmumps_struc_def, ONLY : dmumps_root_struc
      IMPLICIT NONE
      TYPE (DMUMPS_ROOT_STRUC) :: ROOT
      INTEGER INODE, NELIM, NSLAVES 
      INTEGER KEEP( 500 )
      INTEGER(8) KEEP8(150)
      DOUBLE PRECISION DKEEP(230)
      INTEGER ROW_LIST(*), COL_LIST(*), 
     &        SLAVE_LIST(*)
      INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA
      INTEGER IWPOS, IWPOSCB
      INTEGER N, LIW
      INTEGER IW( LIW )
      DOUBLE PRECISION A( LA )
      INTEGER PTRIST( KEEP(28) ), PTLUST_S(KEEP(28))
      INTEGER(8) :: PTRFAC(KEEP(28))
      INTEGER(8) :: PTRAST(KEEP(28))
      INTEGER(8) :: PAMASTER(KEEP(28))
      INTEGER STEP(N), PIMASTER(KEEP(28))
      INTEGER COMP
      INTEGER NSTK_S(KEEP(28)), ITLOC( N + KEEP(253) )
      DOUBLE PRECISION :: RHS_MUMPS(KEEP(255))
      INTEGER PROCNODE_STEPS( KEEP(28) )
      INTEGER IFLAG, IERROR
      INTEGER LPOOL, LEAF
      INTEGER IPOOL( LPOOL )
      INTEGER MYID, SLAVEF
      INTEGER COMM, COMM_LOAD, ND(KEEP(28)), FILS(N), DAD(KEEP(28))
      INTEGER IROOT, TYPE_INODE, DEB_ROW, DEB_COL,
     &        NOINT
      INTEGER(8) :: NOREAL
      include 'mumps_headers.h'
      include 'mumps_tags.h'
      INTEGER MUMPS_TYPENODE
      EXTERNAL mumps_typenode
      iroot        = keep(38)
      nstk_s(step(iroot))= nstk_s(step(iroot)) - 1
      keep(42) = keep(42) + nelim
      type_inode= mumps_typenode( procnode_steps(step(inode)),
     &                            keep(199) )
      IF (type_inode.EQ.1) THEN 
        IF (nelim.EQ.0) THEN
         keep(41) = keep(41) + 1
        ELSE 
         keep(41) = keep(41) + 3
        ENDIF
      ELSE
        IF (nelim.EQ.0) THEN
         keep(41) = keep(41) + nslaves
        ELSE 
         keep(41) = keep(41) + 2*nslaves + 1
        ENDIF
      ENDIF
      IF  (nelim.EQ.0) THEN
        pimaster(step(inode)) = 0 
      ELSE
       noint = 6 + nslaves + nelim  + nelim + keep(ixsz)
       noreal= 0_8
       CALL dmumps_alloc_cb(.false.,0_8,.false.,.false.,
     &   myid,n,keep,keep8,dkeep,iw,liw, a, la,
     &   lrlu, iptrlu,iwpos,iwposcb, slavef, procnode_steps, dad,
     &   ptrist,ptrast,step, pimaster, pamaster,
     &   noint, noreal, inode, s_notfree, .true.,
     &   comp, lrlus, keep8(67), iflag, ierror
     &      )
       IF ( iflag .LT. 0 ) THEN
         WRITE(*,*) ' Failure in int space allocation in CB area ',
     &    ' during assembly of root : DMUMPS_PROCESS_RTNELIND',
     &    ' size required was :', noint,
     &    'INODE=',inode,' NELIM=',nelim, ' NSLAVES=', nslaves
         RETURN
        ENDIF
        pimaster(step( inode )) = iwposcb + 1
        pamaster(step( inode )) = iptrlu  + 1_8
        iw( iwposcb + 1+keep(ixsz) ) = 2*nelim
        iw( iwposcb + 2+keep(ixsz) ) = nelim
        iw( iwposcb + 3+keep(ixsz) ) = 0
        iw( iwposcb + 4+keep(ixsz) ) = 0
        iw( iwposcb + 5+keep(ixsz) ) = 1
        iw( iwposcb + 6+keep(ixsz) ) = nslaves
        IF (nslaves.GT.0) THEN
         iw( iwposcb+7+keep(ixsz):iwposcb+7+keep(ixsz)+nslaves-1) = 
     &                   slave_list(1:nslaves)
        ENDIF
        deb_row = iwposcb+7+nslaves+keep(ixsz)
        iw(deb_row : deb_row+nelim -1) = row_list(1:nelim)
        deb_col = deb_row + nelim
        iw(deb_col : deb_col+nelim -1) = col_list(1:nelim)
      ENDIF
      IF (nstk_s(step(iroot)) .EQ. 0 ) THEN
          CALL dmumps_insert_pool_n(n, ipool, lpool, procnode_steps,
     &         slavef, keep(199),
     &         keep(28), keep(76), keep(80), keep(47),
     &         step, iroot )
          IF (keep(47) .GE. 3) THEN
             CALL dmumps_load_pool_upd_new_pool(
     &            ipool, lpool, 
     &            procnode_steps, keep,keep8, slavef, comm_load,
     &            myid, step, n, nd, fils )
          ENDIF
      END IF
      RETURN