dfac_sol_pool.F File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	dmumps_init_pool_last3 (ipool, lpool, leaf)
subroutine	dmumps_insert_pool_n (n, pool, lpool, procnode, slavef, keep199, k28, k76, k80, k47, step, inode)
logical function	dmumps_pool_empty (pool, lpool)
subroutine	dmumps_extract_pool (n, pool, lpool, procnode, slavef, step, inode, keep, keep8, myid, nd, force_extract_top_sbtr)
subroutine	dmumps_mem_cons_mng (inode, pool, lpool, n, step, keep, keep8, procnode, slavef, myid, sbtr, flag_same_proc, min_proc)
subroutine	dmumps_mem_node_select (inode, pool, lpool, n, step, keep, keep8, procnode, slavef, myid, sbtr_flag, proc_flag, min_proc)
subroutine	dmumps_get_inode_from_pool (ipool, lpool, iii, leaf, inode, strategie)

Function/Subroutine Documentation

dmumps_extract_pool()

subroutine dmumps_extract_pool	(	integer	n,
		integer, dimension(lpool)	pool,
		integer	lpool,
		integer, dimension(keep(28))	procnode,
		integer	slavef,
		integer, dimension(n)	step,
		integer	inode,
		integer, dimension(500)	keep,
		integer(8), dimension(150)	keep8,
		integer	myid,
		integer, dimension(keep(28))	nd,
		logical	force_extract_top_sbtr )

Definition at line 168 of file dfac_sol_pool.F.

      USE dmumps_load
      IMPLICIT NONE
      INTEGER INODE, LPOOL, SLAVEF, N
      INTEGER KEEP(500)
      INTEGER(8) KEEP8(150)
      INTEGER STEP(N), POOL(LPOOL), PROCNODE(KEEP(28)),
     &        ND(KEEP(28))
      EXTERNAL mumps_inssarbr, mumps_rootssarbr, dmumps_pool_empty
      LOGICAL MUMPS_INSSARBR, MUMPS_ROOTSSARBR, DMUMPS_POOL_EMPTY
      EXTERNAL mumps_procnode
      INTEGER MUMPS_PROCNODE
      INTEGER NBINSUBTREE, NBTOP, INSUBTREE, INODE_EFF, MYID
      LOGICAL LEFT, ATOMIC_SUBTREE,UPPER,FLAG_MEM,SBTR_FLAG,PROC_FLAG
      LOGICAL FORCE_EXTRACT_TOP_SBTR
      INTEGER NODE_TO_EXTRACT,I,J,MIN_PROC
      nbinsubtree = pool(lpool)
      nbtop       = pool(lpool - 1)
      insubtree   = pool(lpool - 2)
      IF ( keep(76) > 6 .OR. keep(76) < 0 ) THEN
         WRITE(*,*) "Error 2 in DMUMPS_EXTRACT_POOL: unknown strategy"
         CALL mumps_abort()
      ENDIF
      atomic_subtree =  ( keep(76) == 1 .OR. keep(76) == 3)
      IF ( dmumps_pool_empty(pool, lpool) ) THEN
         WRITE(*,*) "Error 1 in DMUMPS_EXTRACT_POOL"
         CALL mumps_abort()
      ENDIF
      IF ( .NOT. atomic_subtree ) THEN
         left = (nbtop == 0)
         IF(.NOT.left)THEN
            IF((keep(76).EQ.4).OR.(keep(76).EQ.5))THEN
               IF(nbinsubtree.EQ.0)THEN
                  left=.false.
               ELSE
                  IF ( pool(nbinsubtree) < 0 ) THEN
                     i = -pool(nbinsubtree)
                  ELSE IF ( pool(nbinsubtree) > n ) THEN
                     i = pool(nbinsubtree) - n
                  ELSE
                     i = pool(nbinsubtree)
                  ENDIF
                  IF ( pool(lpool-2-nbtop) < 0 ) THEN
                     j = -pool(lpool-2-nbtop)
                  ELSE IF ( pool(lpool-2-nbtop) > n ) THEN
                     j = pool(lpool-2-nbtop) - n
                  ELSE
                     j = pool(lpool-2-nbtop)
                  ENDIF
                  IF(keep(76).EQ.4)THEN
                     IF(depth_first_load(step(j)).GE.
     &                    depth_first_load(step(i)))THEN
                        left=.true.
                     ELSE
                        left=.false.
                     ENDIF
                  ENDIF
                  IF(keep(76).EQ.5)THEN
                     IF(cost_trav(step(j)).LE.
     &                    cost_trav(step(i)))THEN
                        left=.true.
                     ELSE
                        left=.false.
                     ENDIF
                  ENDIF
               ENDIF           
            ENDIF
         ENDIF
      ELSE
         IF ( insubtree == 1 ) THEN
            IF (nbinsubtree == 0) THEN
               WRITE(*,*) "Error 3 in DMUMPS_EXTRACT_POOL"
               CALL mumps_abort()
            ENDIF
            left = .true.
         ELSE
            left = ( nbtop == 0)
         ENDIF
      ENDIF
 222  CONTINUE
      IF ( left ) THEN
         inode = pool( nbinsubtree )
         IF(keep(81).EQ.2)THEN
            IF((inode.GE.0).AND.(inode.LE.n))THEN
               CALL dmumps_mem_node_select(inode,pool,lpool,n,
     &              step,keep,keep8,procnode,slavef,myid,sbtr_flag,
     &              proc_flag,min_proc)
               IF(.NOT.sbtr_flag)THEN
                  WRITE(*,*)myid,': ca a change pour moi'
                  left=.false.
                  GOTO 222
               ENDIF
            ENDIF
         ELSEIF(keep(81).EQ.3)THEN
            IF((inode.GE.0).AND.(inode.LE.n))THEN
               node_to_extract=inode
               flag_mem=.false.
               CALL dmumps_load_chk_memcst_pool(flag_mem)
               IF(flag_mem)THEN
                  CALL dmumps_mem_node_select(inode,pool,lpool,n,
     &                 step,keep,keep8,
     &                 procnode,slavef,myid,sbtr_flag,
     &                 proc_flag,min_proc)
                  IF(.NOT.sbtr_flag)THEN
                     left=.false.
                     WRITE(*,*)myid,': ca a change pour moi (2)'
                     GOTO 222
                  ENDIF
               ENDIF
            ENDIF
         ENDIF
         nbinsubtree = nbinsubtree - 1
         IF ( inode < 0 ) THEN
            inode_eff = -inode
         ELSE IF ( inode > n ) THEN
            inode_eff = inode - n
         ELSE
            inode_eff = inode
         ENDIF
         IF ( mumps_inssarbr( procnode(step(inode_eff)),
     &                        keep(199)) ) THEN
            IF((keep(47).GE.2.AND.keep(81).EQ.1).AND.
     &           (insubtree.EQ.0))THEN
               CALL dmumps_load_set_sbtr_mem(.true.)
            ENDIF
            insubtree = 1
         ELSE IF ( mumps_rootssarbr( procnode(step(inode_eff)), 
     &           keep(199))) THEN
            IF((keep(47).GE.2.AND.keep(81).EQ.1).AND.
     &           (insubtree.EQ.1))THEN
               CALL dmumps_load_set_sbtr_mem(.false.)
            ENDIF
            insubtree = 0
         END IF
      ELSE
         IF (nbtop < 1 ) THEN
            WRITE(*,*) "Error 5 in DMUMPS_EXTRACT_POOL", nbtop
            CALL mumps_abort()
         ENDIF
         inode = pool( lpool - 2 - nbtop )
         IF(keep(81).EQ.1)THEN
            CALL dmumps_load_pool_check_mem
     &           (inode,upper,slavef,keep,keep8,
     &            step,pool,lpool,procnode,n)
            IF(upper)THEN
               GOTO 666
            ELSE
               nbinsubtree=nbinsubtree-1
               IF ( mumps_inssarbr( procnode(step(inode)), 
     &              keep(199)) ) THEN
                  insubtree = 1
               ELSE IF ( mumps_rootssarbr( procnode(step(inode)), 
     &                 keep(199))) THEN
                  insubtree = 0
               ENDIF
               GOTO 777
            ENDIF
         ENDIF
         IF(keep(81).EQ.2)THEN
            CALL dmumps_mem_node_select(inode,pool,lpool,n,step,
     &           keep,keep8,
     &           procnode,slavef,myid,sbtr_flag,proc_flag,min_proc)
            IF(sbtr_flag)THEN
               left=.true. 
               WRITE(*,*)myid,': ca a change pour moi (3)'              
               GOTO 222
            ENDIF
         ELSE
            IF(keep(81).EQ.3)THEN
               IF((inode.GE.0).AND.(inode.LE.n))THEN
                  node_to_extract=inode
                  flag_mem=.false.
                  CALL dmumps_load_chk_memcst_pool(flag_mem)
                  IF(flag_mem)THEN
                     CALL dmumps_mem_node_select(inode,pool,lpool,n,
     &                    step,keep,keep8,
     &                    procnode,slavef,myid,sbtr_flag,
     &                    proc_flag,min_proc)
                     IF(sbtr_flag)THEN
                        left=.true.
                        WRITE(*,*)myid,': ca a change pour moi (4)'
                        GOTO 222
                     ENDIF
                  ELSE
                     CALL dmumps_load_clean_meminfo_pool(inode)
                  ENDIF
               ENDIF
            ENDIF
         ENDIF
 666     CONTINUE
         nbtop = nbtop - 1
         IF((inode.GT.0).AND.(inode.LE.n))THEN
            IF ((( keep(80) == 2 .OR. keep(80)==3 ) .AND.
     &           ( keep(47) == 4 ))) THEN
               CALL dmumps_remove_node(inode,2)
            ENDIF
         ENDIF
         IF ( inode < 0 ) THEN
            inode_eff = -inode
         ELSE IF ( inode > n ) THEN
            inode_eff = inode - n
         ELSE
            inode_eff = inode
         ENDIF
      END IF
 777  CONTINUE
      pool(lpool)     = nbinsubtree 
      pool(lpool - 1) = nbtop
      pool(lpool - 2) = insubtree
      RETURN

dmumps_get_inode_from_pool()

subroutine dmumps_get_inode_from_pool	(	integer, dimension (lpool)	ipool,
		integer, intent(in)	lpool,
		integer	iii,
		integer	leaf,
		integer, intent(out)	inode,
		integer, intent(in)	strategie )

Definition at line 514 of file dfac_sol_pool.F.

            IMPLICIT NONE
      INTEGER, INTENT(IN) :: STRATEGIE, LPOOL
      INTEGER IPOOL (LPOOL)
      INTEGER III,LEAF
      INTEGER, INTENT(OUT) :: INODE
         leaf  = leaf - 1
         inode = ipool( leaf )
      RETURN

dmumps_init_pool_last3()

subroutine dmumps_init_pool_last3	(	integer, dimension(lpool)	ipool,
		integer	lpool,
		integer	leaf )

Definition at line 14 of file dfac_sol_pool.F.

      USE dmumps_load
      IMPLICIT NONE
      INTEGER LPOOL, LEAF
      INTEGER IPOOL(LPOOL)
      ipool(lpool-2) = 0
      ipool(lpool-1) = 0
      ipool(lpool)   = leaf-1
      RETURN

dmumps_insert_pool_n()

subroutine dmumps_insert_pool_n	(	integer	n,
		integer, dimension(lpool)	pool,
		integer	lpool,
		integer, dimension(k28)	procnode,
		integer	slavef,
		integer	keep199,
		integer	k28,
		integer	k76,
		integer	k80,
		integer	k47,
		integer, dimension(n)	step,
		integer	inode )

Definition at line 24 of file dfac_sol_pool.F.

      USE dmumps_load
      IMPLICIT NONE
      INTEGER N, INODE, LPOOL, K28, SLAVEF, K76, K80, K47, KEEP199
      INTEGER STEP(N), POOL(LPOOL), PROCNODE(K28)
      EXTERNAL mumps_in_or_root_ssarbr
      LOGICAL MUMPS_IN_OR_ROOT_SSARBR, ATM_CURRENT_NODE
      INTEGER NBINSUBTREE, NBTOP, INODE_EFF,POS_TO_INSERT
      INTEGER IPOS1, IPOS2, ISWAP
      INTEGER NODE,J,I
      atm_current_node = ( k76 == 2 .OR. k76 ==3 .OR.
     &     k76==4 .OR. k76==5)
      nbinsubtree = pool(lpool)
      nbtop       = pool(lpool - 1)
      IF (inode > n ) THEN
        inode_eff = inode - n
      ELSE IF (inode < 0) THEN
        inode_eff = - inode
      ELSE
        inode_eff = inode
      ENDIF
      IF(((inode.GT.0).AND.(inode.LE.n)).AND.(.NOT.
     &     mumps_in_or_root_ssarbr(procnode(step(inode_eff)),
     &               keep199))
     &  ) THEN
         IF ((k80 == 1 .AND. k47 .GE. 1) .OR.
     &     (( k80 == 2 .OR. k80==3 ) .AND.
     &          ( k47 == 4 ))) THEN
            CALL dmumps_remove_node(inode,1)
         ENDIF
      ENDIF
      IF ( mumps_in_or_root_ssarbr(procnode(step(inode_eff)),
     &                             keep199) ) THEN
        pool(nbinsubtree + 1 ) = inode
        nbinsubtree = nbinsubtree + 1
      ELSE
         pos_to_insert=nbtop+1
         IF((k76.EQ.4).OR.(k76.EQ.5).OR.(k76.EQ.6))THEN
            IF((inode.GT.n).OR.(inode.LE.0))THEN
               DO j=nbtop,1,-1
                  IF((pool(lpool-2-j).GT.0)
     &                 .AND.(pool(lpool-2-j).LE.n))THEN
                     GOTO 333
                  ENDIF
                  IF ( pool(lpool-2-j) < 0 ) THEN
                     node=-pool(lpool-2-j)
                  ELSE IF ( pool(lpool-2-j) > n ) THEN
                     node = pool(lpool-2-j) - n
                  ELSE
                     node = pool(lpool-2-j)
                  ENDIF
                  IF((k76.EQ.4).OR.(k76.EQ.6))THEN
                     IF(depth_first_load(step(node)).GE.
     &                    depth_first_load(step(inode_eff)))THEN
                        GOTO 333
                     ENDIF
                  ENDIF
                  IF(k76.EQ.5)THEN
                     IF(cost_trav(step(node)).LE.
     &                    cost_trav(step(inode_eff)))THEN
                        GOTO 333
                     ENDIF
                  ENDIF
                  pos_to_insert=pos_to_insert-1
               ENDDO
               IF(j.EQ.0) j=1
 333           CONTINUE
               DO i=nbtop,pos_to_insert,-1
                  pool(lpool-2-i-1)=pool(lpool-2-i)
               ENDDO
               pool(lpool-2-pos_to_insert)=inode
               nbtop = nbtop + 1
               GOTO 20 
            ENDIF
            DO j=nbtop,1,-1
               IF((pool(lpool-2-j).GT.0).AND.(pool(lpool-2-j).LE.n))THEN
                  GOTO 888
               ENDIF
               pos_to_insert=pos_to_insert-1
            ENDDO
 888        CONTINUE
            DO i=j,1,-1
               node=pool(lpool-2-i)
               IF((k76.EQ.4).OR.(k76.EQ.6))THEN
                  IF(depth_first_load(step(node)).GE.
     &                 depth_first_load(step(inode_eff)))THEN
                     GOTO 999
                  ENDIF
               ENDIF
               IF(k76.EQ.5)THEN
                  IF(cost_trav(step(node)).LE.
     &                 cost_trav(step(inode_eff)))THEN
                     GOTO 999
                  ENDIF
               ENDIF
               pos_to_insert=pos_to_insert-1
            ENDDO
            IF(i.EQ.0) i=1
 999        CONTINUE
            DO j=nbtop,pos_to_insert,-1
               pool(lpool-2-j-1)=pool(lpool-2-j)
            ENDDO
            pool(lpool-2-pos_to_insert)=inode
            nbtop = nbtop + 1
            GOTO 20
         ENDIF
         pool( lpool - 2 - ( nbtop + 1 ) ) = inode
         nbtop = nbtop + 1
        ipos1 = lpool - 2 - nbtop
        ipos2 = lpool - 2 - nbtop + 1
 10     CONTINUE
        IF ( ipos2 == lpool - 2 ) GOTO 20
        IF ( pool(ipos1) < 0 ) GOTO 20
        IF ( pool(ipos2) < 0 ) GOTO 30
        IF ( atm_current_node ) THEN
          IF ( pool(ipos1) > n ) GOTO 20
          IF ( pool(ipos2) > n ) GOTO 30
        END IF
        GOTO 20
 30     CONTINUE
        iswap = pool(ipos1)
        pool(ipos1) = pool(ipos2)
        pool(ipos2) = iswap
        ipos1 = ipos1 + 1
        ipos2 = ipos2 + 1
        GOTO 10
 20     CONTINUE
      ENDIF
      pool(lpool) = nbinsubtree 
      pool(lpool - 1) = nbtop
      RETURN

dmumps_mem_cons_mng()

subroutine dmumps_mem_cons_mng	(	integer	inode,
		integer, dimension(lpool)	pool,
		integer	lpool,
		integer	n,
		integer, dimension(n)	step,
		integer, dimension(500)	keep,
		integer(8), dimension(150)	keep8,
		integer, dimension(keep(28))	procnode,
		integer	slavef,
		integer	myid,
		logical	sbtr,
		logical	flag_same_proc,
		integer	min_proc )

Definition at line 381 of file dfac_sol_pool.F.

      USE dmumps_load
      IMPLICIT NONE
      INTEGER INODE,LPOOL,N,MYID,SLAVEF,PROC,MIN_PROC
      INTEGER POOL(LPOOL),KEEP(500),STEP(N),PROCNODE(KEEP(28))
      INTEGER(8) KEEP8(150)
      INTEGER MUMPS_PROCNODE
      EXTERNAL mumps_procnode
      LOGICAL SBTR,FLAG_SAME_PROC
      INTEGER POS_TO_EXTRACT,NODE_TO_EXTRACT,NBTOP,I,INSUBTREE,
     &     NBINSUBTREE
      DOUBLE PRECISION MIN_COST, TMP_COST
      nbinsubtree = pool(lpool)
      nbtop       = pool(lpool - 1)
      insubtree   = pool(lpool - 2)
      min_cost=huge(min_cost) 
      tmp_cost=huge(tmp_cost)
      flag_same_proc=.false.
      sbtr=.false.
      min_proc=-9999
      IF((inode.GT.0).AND.(inode.LE.n))THEN
         pos_to_extract=-1
         node_to_extract=-1
         DO i=nbtop,1,-1
            IF(node_to_extract.LT.0)THEN
               pos_to_extract=i
               node_to_extract=pool(lpool-2-i)
               CALL dmumps_load_comp_maxmem_pool(node_to_extract,
     &                                       tmp_cost,proc)
               min_cost=tmp_cost
               min_proc=proc
            ELSE
               CALL dmumps_load_comp_maxmem_pool(pool(lpool-2-i),
     &                                       tmp_cost,proc)
               IF((proc.NE.min_proc).OR.(tmp_cost.NE.min_cost))THEN
                  flag_same_proc=.true.
               ENDIF
               IF(tmp_cost.GT.min_cost)THEN
                  pos_to_extract=i
                  node_to_extract=pool(lpool-2-i)
                  min_cost=tmp_cost
                  min_proc=proc
               ENDIF
            ENDIF
         ENDDO
         IF((keep(47).EQ.4).AND.(nbinsubtree.NE.0))THEN
            CALL dmumps_check_sbtr_cost(nbinsubtree,insubtree,nbtop,
     &           min_cost,sbtr)
            IF(sbtr)THEN
               WRITE(*,*)myid,': selecting from subtree'
               RETURN
            ENDIF
         ENDIF
         IF((.NOT.sbtr).AND.(.NOT.flag_same_proc))THEN
            WRITE(*,*)myid,': I must search for a task
     &           to save My friend'
            RETURN
         ENDIF
         inode = node_to_extract
         DO i=pos_to_extract,nbtop
            IF(i.NE.nbtop)THEN
               pool(lpool-2-i)=pool(lpool-2-i-1)
            ENDIF
         ENDDO
         pool(lpool-2-nbtop)=inode
         CALL dmumps_load_clean_meminfo_pool(inode)
      ELSE
      ENDIF

dmumps_mem_node_select()

subroutine dmumps_mem_node_select	(	integer	inode,
		integer, dimension(lpool)	pool,
		integer	lpool,
		integer	n,
		integer, dimension(n)	step,
		integer, dimension(500)	keep,
		integer(8), dimension(150)	keep8,
		integer, dimension(keep(28))	procnode,
		integer	slavef,
		integer	myid,
		logical	sbtr_flag,
		logical	proc_flag,
		integer	min_proc )

Definition at line 452 of file dfac_sol_pool.F.

      USE dmumps_load
      IMPLICIT NONE
      INTEGER INODE,LPOOL,N,SLAVEF,MYID,MIN_PROC
      INTEGER POOL(LPOOL),KEEP(500),PROCNODE(KEEP(28)),STEP(N)
      INTEGER(8) KEEP8(150)
      LOGICAL SBTR_FLAG,PROC_FLAG
      EXTERNAL mumps_inssarbr
      LOGICAL MUMPS_INSSARBR
      INTEGER NODE_TO_EXTRACT,I,POS_TO_EXTRACT,NBTOP,NBINSUBTREE
      nbtop= pool(lpool - 1)
      nbinsubtree = pool(lpool)
      IF(nbtop.GT.0)THEN
         WRITE(*,*)myid,': NBTOP=',nbtop
      ENDIF
      sbtr_flag=.false.
      proc_flag=.false.
      CALL dmumps_mem_cons_mng(inode,pool,lpool,n,step,keep,keep8,
     &     procnode,slavef,myid,sbtr_flag,proc_flag,min_proc)
      IF(sbtr_flag)THEN
         RETURN
      ENDIF
      IF(min_proc.EQ.-9999)THEN
         IF((inode.GT.0).AND.(inode.LT.n))THEN
            sbtr_flag=(nbinsubtree.NE.0)
         ENDIF
         RETURN
      ENDIF
      IF(.NOT.proc_flag)THEN
         node_to_extract=inode
         IF((inode.GE.0).AND.(inode.LE.n))THEN
            CALL dmumps_find_best_node_for_mem(min_proc,pool,
     &           lpool,inode)
            IF(mumps_inssarbr(procnode(step(inode)),
     &           keep(199)))THEN
               WRITE(*,*)myid,': Extracting from a subtree
     &              for helping',min_proc
               sbtr_flag=.true.
               RETURN
            ELSE
               IF(node_to_extract.NE.inode)THEN
                  WRITE(*,*)myid,': Extracting from top
     &                 inode=',inode,'for helping',min_proc
               ENDIF
               CALL dmumps_load_clean_meminfo_pool(inode)
            ENDIF
         ENDIF
         DO i=1,nbtop
            IF (pool(lpool-2-i).EQ.inode)THEN
               GOTO 452
            ENDIF
         ENDDO
 452     CONTINUE
         pos_to_extract=i
         DO i=pos_to_extract,nbtop-1
            pool(lpool-2-i)=pool(lpool-2-i-1)
         ENDDO
         pool(lpool-2-nbtop)=inode
      ENDIF

dmumps_pool_empty()

logical function dmumps_pool_empty	(	integer, dimension(lpool)	pool,
		integer	lpool )

Definition at line 158 of file dfac_sol_pool.F.

      IMPLICIT NONE
      INTEGER LPOOL
      INTEGER POOL(LPOOL)
      INTEGER NBINSUBTREE, NBTOP
      nbinsubtree = pool(lpool)
      nbtop       = pool(lpool - 1)
      dmumps_pool_empty = (nbinsubtree + nbtop == 0)
      RETURN