cfac_lastrtnelind.F File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine

cmumps_last_rtnelind (comm_load, ass_irecv, root, frere, iroot, bufr, lbufr, lbufr_bytes, procnode_steps, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust_s, ptrfac, ptrast, step, pimaster, pamaster, nstk_s, comp, iflag, ierror, comm, perm, ipool, lpool, leaf, nbfin, myid, slavef opassw, opeliw, 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)

Function/Subroutine Documentation

cmumps_last_rtnelind()

subroutine cmumps_last_rtnelind	(	integer	comm_load,
		integer	ass_irecv,
		type (cmumps_root_struc)	root,
		integer, dimension(keep(28))	frere,
		integer	iroot,
		integer, dimension( lbufr )	bufr,
		integer	lbufr,
		integer	lbufr_bytes,
		integer, dimension( keep(28) )	procnode_steps,
		integer(8)	posfac,
		integer	iwpos,
		integer	iwposcb,
		integer(8)	iptrlu,
		integer(8)	lrlu,
		integer(8)	lrlus,
		integer	n,
		integer, dimension( liw )	iw,
		integer	liw,
		complex, 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	comp,
		integer	iflag,
		integer	ierror,
		integer	comm,
		integer, dimension(n)	perm,
		integer, dimension( lpool )	ipool,
		integer	lpool,
		integer	leaf,
		integer	nbfin,
		integer	myid,
		integer	slavef,
		double precision	opassw,
		double precision	opeliw,
		integer, dimension( n+keep(253) )	itloc,
		complex, dimension(keep(255))	rhs_mumps,
		integer, dimension( n )	fils,
		integer, dimension( keep(28) )	dad,
		integer(8), dimension( lptrar ), intent(in)	ptrarw,
		integer(8), dimension( lptrar ), intent(in)	ptraiw,
		integer, dimension( keep8(27) )	intarr,
		complex, dimension( keep8(26) )	dblarr,
		integer, dimension( 60 )	icntl,
		integer, dimension( 500 )	keep,
		integer(8), dimension(150)	keep8,
		real, dimension(230)	dkeep,
		integer, dimension(keep(28))	nd,
		integer	lptrar,
		integer	nelt,
		integer, dimension( n+1 )	frtptr,
		integer, dimension( nelt )	frtelt,
		integer, dimension(keep(71))	istep_to_iniv2,
		integer, dimension(slavef+2,max(1,keep(56)))	tab_pos_in_pere,
		integer, dimension(n), intent(in)	lrgroups )

Definition at line 14 of file cfac_lastrtnelind.F.

      USE cmumps_buf
      USE cmumps_struc_def, ONLY : cmumps_root_struc
      IMPLICIT NONE
      include 'mpif.h'
      TYPE (CMUMPS_ROOT_STRUC) :: root
      INTEGER IROOT
      INTEGER ICNTL( 60 ), KEEP( 500 )
      INTEGER(8) KEEP8(150)
      REAL    DKEEP(230)
      INTEGER COMM_LOAD, ASS_IRECV
      INTEGER LBUFR, LBUFR_BYTES
      INTEGER BUFR( LBUFR )
      INTEGER(8) :: POSFAC,IPTRLU, LRLU, LRLUS
      INTEGER IWPOS, IWPOSCB
      INTEGER(8) :: LA
      INTEGER N, LIW
      INTEGER IW( LIW )
      COMPLEX A( LA )
      INTEGER, intent(in) :: LRGROUPS(N)
      INTEGER(8) :: PTRAST(KEEP(28))
      INTEGER(8) :: PTRFAC(KEEP(28))
      INTEGER(8) :: PAMASTER(KEEP(28))
      INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28))
      INTEGER STEP(N), PIMASTER(KEEP(28))
      INTEGER COMP
      INTEGER NSTK_S( KEEP(28) ), PROCNODE_STEPS( KEEP(28) )
      INTEGER PERM(N)
      INTEGER IFLAG, IERROR, COMM
      INTEGER LPTRAR, NELT
      INTEGER FRTPTR( N+1 ), FRTELT( NELT )
      INTEGER LPOOL, LEAF
      INTEGER IPOOL( LPOOL )
      INTEGER MYID, SLAVEF, NBFIN
      INTEGER ISTEP_TO_INIV2(KEEP(71)), 
     &        TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
      DOUBLE PRECISION OPASSW, OPELIW
      INTEGER ITLOC( N+KEEP(253) ), FILS( N ), DAD( KEEP(28) )
      COMPLEX :: RHS_MUMPS(KEEP(255))
      INTEGER(8), INTENT(IN) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR )
      INTEGER ND(KEEP(28)), FRERE(KEEP(28))
      COMPLEX DBLARR( KEEP8(26) )
      INTEGER INTARR( KEEP8(27) )
      INTEGER I, NELIM, NB_CONTRI_GLOBAL, NUMORG, 
     &        NFRONT, IROW, JCOL, PDEST, HF, IOLDPS,
     &        IN, DEB_ROW, ILOC_ROW, IFSON, ILOC_COL,
     &        IPOS_SON, NELIM_SON, NSLAVES_SON, HS,
     &        IROW_SON, ICOL_SON, ISLAVE, IERR, 
     &        NELIM_SENT, IPOS_STATREC, TYPE_SON
      INTEGER MUMPS_PROCNODE
      EXTERNAL mumps_procnode
      include 'mumps_headers.h'
      include 'mumps_tags.h'
      nb_contri_global = keep(41)
      numorg    = root%ROOT_SIZE
      nelim     = keep(42)
      nfront    = numorg + keep(42)
      DO irow = 0, root%NPROW - 1
        DO jcol = 0, root%NPCOL - 1
            pdest = irow * root%NPCOL + jcol
          IF ( pdest .NE. myid ) THEN
           CALL cmumps_buf_send_root2slave(nfront, 
     &     nb_contri_global, pdest, comm, keep, ierr)
           if (ierr.lt.0) then
                write(6,*) ' error detected by ',
     &          'cmumps_buf_send_root2slave'
                CALL MUMPS_ABORT()
               endif
           ENDIF
        END DO
      END DO
      CALL  CMUMPS_PROCESS_ROOT2SLAVE( NFRONT,
     &    NB_CONTRI_GLOBAL, root,
     &    BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
     &    IWPOS, IWPOSCB, IPTRLU,
     &    LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
     &    PTLUST_S, PTRFAC,
     &    PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
     &    IFLAG, IERROR, COMM, COMM_LOAD,
     &    IPOOL, LPOOL, LEAF,
     &    NBFIN, MYID, SLAVEF,
     &
     &    OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, DAD,
     &    LPTRAR, NELT, FRTPTR, FRTELT,
     &    PTRARW, PTRAIW,
     &    INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND )
       IF (IFLAG < 0 ) RETURN
      HF = 6 + KEEP(IXSZ)
      IOLDPS = PTLUST_S(STEP(IROOT))
      IN = IROOT
      DEB_ROW = IOLDPS + HF
      ILOC_ROW    = DEB_ROW
.GT.      DO WHILE (IN0) 
       IW(ILOC_ROW)           = IN
       IW(ILOC_ROW+NFRONT)    = IN
       ILOC_ROW = ILOC_ROW + 1
       IN = FILS(IN)
      END DO
      IFSON = -IN
      ILOC_ROW    = IOLDPS + HF + NUMORG
      ILOC_COL    = ILOC_ROW + NFRONT
.GT.      IF ( NELIM0 ) THEN
        IN = IFSON
.GT.        DO WHILE (IN0)
          IPOS_SON  = PIMASTER(STEP(IN))
.EQ.          IF (IPOS_SON  0) GOTO 100
          NELIM_SON   = IW(IPOS_SON+1+KEEP(IXSZ))
.eq.          if (NELIM_SON0) then
                write(6,*) ' error 1 in process_last_rtnelind'
                CALL MUMPS_ABORT()
              endif
          NSLAVES_SON = IW(IPOS_SON+5+KEEP(IXSZ))
          HS          = 6 + NSLAVES_SON + KEEP(IXSZ)
          IROW_SON    = IPOS_SON + HS
          ICOL_SON    = IROW_SON + NELIM_SON
          DO I = 1, NELIM_SON
            IW( ILOC_ROW+I-1 ) = IW( IROW_SON+I-1 )
          ENDDO
          DO I = 1, NELIM_SON
            IW( ILOC_COL+I-1 ) = IW( ICOL_SON+I-1 )
          ENDDO
          NELIM_SENT = ILOC_ROW - IOLDPS - HF + 1
          DO ISLAVE = 0,NSLAVES_SON
.EQ.            IF (ISLAVE0) THEN
             PDEST= MUMPS_PROCNODE(PROCNODE_STEPS(STEP(IN)),KEEP(199))
            ELSE
             PDEST = IW(IPOS_SON + 5 + ISLAVE+KEEP(IXSZ))
            ENDIF
.NE.            IF (PDESTMYID) THEN
             CALL CMUMPS_BUF_SEND_ROOT2SON(IN, NELIM_SENT,
     &        PDEST, COMM, KEEP, IERR )
.lt.             if (IERR0) then
                write(6,*) ' error detected by ',
     &          'cmumps_buf_send_root2slave'
                CALL MUMPS_ABORT()
               endif
            ELSE
             CALL CMUMPS_PROCESS_ROOT2SON( COMM_LOAD, ASS_IRECV,
     &       IN, NELIM_SENT, root,
     &
     &       BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
     &       IWPOS, IWPOSCB, IPTRLU,
     &       LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 
     &       PTLUST_S, PTRFAC,
     &       PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
     &       IFLAG, IERROR, COMM,
     &       PERM,
     &       IPOOL, LPOOL, LEAF,
     &       NBFIN, MYID, SLAVEF,
     &
     &       OPASSW, OPELIW, 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
     &               , LRGROUPS
     &       )
.NE.             IF ( ISLAVE  0 ) THEN
.EQ.               IF (KEEP(50)  0) THEN
                IPOS_STATREC = PTRIST(STEP(IN))+6+KEEP(IXSZ)
               ELSE
                IPOS_STATREC = PTRIST(STEP(IN))+8+KEEP(IXSZ)
               ENDIF
.EQ.               IF (IW(IPOS_STATREC) S_REC_CONTSTATIC) THEN
                  IW(IPOS_STATREC) = S_ROOT2SON_CALLED
               ELSE
.EQ.                IF (NSLAVES_SON  0) THEN
                  TYPE_SON = 1
                ELSE
                  TYPE_SON = 2
                ENDIF
                CALL CMUMPS_FREE_BAND( N, IN, PTRIST, PTRAST,
     &          IW, LIW, A, LA, LRLU, LRLUS, IWPOSCB,
     &          IPTRLU, STEP, MYID, KEEP, KEEP8, TYPE_SON
     &        )
               ENDIF
             ENDIF
             IPOS_SON  = PIMASTER(STEP(IN))
            ENDIF
          END DO
          CALL  CMUMPS_FREE_BLOCK_CB_STATIC(
     &       .FALSE., MYID, N, IPOS_SON,
     &       IW, LIW,
     &       LRLU, LRLUS, IPTRLU,
     &       IWPOSCB, LA, KEEP,KEEP8, .FALSE.
     &         )
          ILOC_ROW = ILOC_ROW + NELIM_SON
          ILOC_COL = ILOC_COL + NELIM_SON
 100      CONTINUE
          IN = FRERE(STEP(IN))
        ENDDO
      ENDIF
      RETURN