sol_common.F File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	mumps_sol_get_npiv_liell_ipos (istep, keep, npiv, liell, ipos, iw, liw, ptrist, step, n)
subroutine	mumps_build_irhs_loc (myid_nodes, nslaves, n, ptrist, keep, keep8, iw, liw, step, procnode_steps, irhs_loc, row_or_col_indices)
subroutine	mumps_sol_rhsmapinfo (n, nloc_rhs, info23, irhs_loc, map_rhs_loc, posinrhscomp_fwd, nslaves, myid_nodes, comm_nodes, icntl, info)
subroutine	mumps_compute_lastfs_dyn (inode, lastfssbtr_dyn, mtype, keep, iw, liw, n, step, ptrist, fils, frere)

Function/Subroutine Documentation

mumps_build_irhs_loc()

subroutine mumps_build_irhs_loc	(	integer, intent(in)	myid_nodes,
		integer, intent(in)	nslaves,
		integer, intent(in)	n,
		integer, dimension(keep(28)), intent(in)	ptrist,
		integer, dimension(500), intent(in)	keep,
		integer(8), dimension(150), intent(in)	keep8,
		integer, dimension(liw), intent(in)	iw,
		integer, intent(in)	liw,
		integer, dimension(n), intent(in)	step,
		integer, dimension(keep(28)), intent(in)	procnode_steps,
		integer, dimension(keep(89)), intent(out)	irhs_loc,
		integer, intent(in)	row_or_col_indices )

Definition at line 52 of file sol_common.F.

      IMPLICIT NONE
      INTEGER, INTENT(IN)    :: KEEP(500)
      INTEGER(8), INTENT(IN) :: KEEP8(150)
      INTEGER, INTENT(IN)    :: MYID_NODES, NSLAVES, N, LIW
      INTEGER, INTENT(IN)    :: PTRIST(KEEP(28))
      INTEGER, INTENT(IN)    :: IW(LIW), STEP(N)
      INTEGER, INTENT(IN)    :: PROCNODE_STEPS(KEEP(28))
      INTEGER, INTENT(OUT)   :: IRHS_loc(KEEP(89))
      INTEGER, INTENT(IN)    :: ROW_OR_COL_INDICES
      INTEGER :: ISTEP
      INTEGER :: NPIV, LIELL, IPOS
      INTEGER :: IIRHS_loc 
      INTEGER :: J1 
      include 'mumps_headers.h'
      INTEGER, EXTERNAL :: MUMPS_PROCNODE
      iirhs_loc = 0
      DO istep = 1, keep(28)
        IF (myid_nodes == mumps_procnode(procnode_steps(istep),
     &                                   keep(199))) THEN
          CALL mumps_sol_get_npiv_liell_ipos ( istep, keep,
     &           npiv, liell, ipos, iw, liw, ptrist, step, n )
          IF ( row_or_col_indices .EQ. 0 .OR. keep(50).NE.0 ) THEN
            j1 = ipos + 1
          ELSE IF (row_or_col_indices .EQ. 1 ) THEN
            j1 = ipos + liell + 1
          ELSE
            WRITE(*,*) "Internal error 1 in MUMPS_BUILD_IRHS_loc",
     &      row_or_col_indices
            CALL mumps_abort()
          ENDIF
          IF (iirhs_loc+npiv .GT. keep(89)) THEN
            WRITE(*,*) "Internal error 2 in MUMPS_BUILD_IRHS_loc",
     &      iirhs_loc, keep(89)
            CALL mumps_abort()
          ENDIF
          irhs_loc(iirhs_loc+1:iirhs_loc+npiv)=iw(j1:j1+npiv-1)
          iirhs_loc=iirhs_loc+npiv
        ENDIF
      ENDDO
      IF (iirhs_loc .NE. keep(89)) THEN
        WRITE(*,*) "Internal error 3 in MUMPS_BUILD_IRHS_loc",
     &  iirhs_loc, keep(89)
        CALL mumps_abort()
      ENDIF
      RETURN

mumps_compute_lastfs_dyn()

subroutine mumps_compute_lastfs_dyn	(	integer, intent(in)	inode,
		integer, intent(out)	lastfssbtr_dyn,
		integer, intent(in)	mtype,
		integer, dimension(500), intent(in)	keep,
		integer, dimension(liw), intent(in)	iw,
		integer, intent(in)	liw,
		integer, intent(in)	n,
		integer, dimension( n ), intent(in)	step,
		integer, dimension( keep(28) ), intent(in)	ptrist,
		integer, dimension(n), intent(in)	fils,
		integer, dimension( keep(28) ), intent(in)	frere )

Definition at line 161 of file sol_common.F.

      IMPLICIT NONE
      INTEGER, INTENT(IN)  :: INODE
      INTEGER, INTENT(OUT) :: LASTFSSBTR_DYN
      INTEGER, INTENT(IN)  :: N, MTYPE, LIW, KEEP(500)
      INTEGER, INTENT(IN)  :: IW(LIW), STEP( N ), PTRIST( KEEP(28) )
      INTEGER, INTENT(IN)  :: FILS(N), FRERE( KEEP(28) )
      INTEGER :: NPIV, LIELL, IPOS, INODE_CUR, IN
      inode_cur = inode
 10   CONTINUE
      CALL  mumps_sol_get_npiv_liell_ipos ( step(inode_cur), keep,
     &     npiv, liell, ipos, iw, liw, ptrist, step, n )
      IF ( npiv .NE. 0 ) THEN
        IF (mtype .EQ. 1 .OR. keep(50) .NE. 0) THEN
          lastfssbtr_dyn = iw( ipos + npiv )
        ELSE
          lastfssbtr_dyn = iw( ipos+npiv+liell )
        ENDIF
      ELSE
        in = inode_cur
        DO WHILE (in.GT. 0)
          in = fils(in)
        ENDDO
        IF (in .LT. 0) THEN
          inode_cur = -in
          GOTO 10
        ELSE
          DO
            IF (inode_cur .EQ. inode) THEN
              lastfssbtr_dyn = 0
              EXIT
            ENDIF
            inode_cur = frere(step(inode_cur))
            IF (inode_cur .GT. 0) THEN
              GOTO 10
            ELSE
              inode_cur = -inode_cur
            ENDIF
          ENDDO
        ENDIF
      ENDIF
      RETURN

mumps_sol_get_npiv_liell_ipos()

subroutine mumps_sol_get_npiv_liell_ipos	(	integer, intent(in)	istep,
		integer, dimension(500), intent(in)	keep,
		integer, intent(out)	npiv,
		integer, intent(out)	liell,
		integer, intent(out)	ipos,
		integer, dimension( liw ), intent(in)	iw,
		integer, intent(in)	liw,
		integer, dimension( keep(28) ), intent(in)	ptrist,
		integer, dimension( n ), intent(in)	step,
		integer, intent(in)	n )

Definition at line 14 of file sol_common.F.

      IMPLICIT NONE
      INTEGER, INTENT(IN)  :: ISTEP, LIW, KEEP(500), N
      INTEGER, INTENT(IN)  :: IW( LIW )
      INTEGER, INTENT(IN)  :: STEP( N ), PTRIST( KEEP(28) )
      INTEGER, INTENT(OUT) :: NPIV, LIELL, IPOS
      include 'mumps_headers.h'
      INTEGER :: SROOT
      IF (keep(38) .NE. 0) THEN
        sroot = step(keep(38))
      ELSE IF (keep(20) .NE. 0) THEN
        sroot = step(keep(20))
      ELSE
        sroot = 0
      ENDIF
      ipos = ptrist(istep)
      IF (ipos .LE. 0) THEN
        WRITE(*,*) "Internal error 1 in MUMPS_SOL_GET_NPIV_LIELL_IPOS",
     &  istep 
        CALL mumps_abort()
      ENDIF
      npiv = iw(ipos+3+keep(ixsz))
      IF ( istep.EQ.sroot ) THEN
             ipos = ptrist(istep)
             liell = iw(ipos+3+keep(ixsz))
             npiv = liell
             ipos= ptrist(istep)+5+keep(ixsz)
      ELSE
             ipos = ptrist(istep) + 2+ keep(ixsz)
             liell = iw(ipos-2)+iw(ipos+1)
             ipos= ipos+1
             npiv = iw(ipos)
             ipos= ipos+1
             ipos= ipos+1+iw( ptrist(istep) + 5 +keep(ixsz))
      ENDIF
      RETURN

mumps_sol_rhsmapinfo()

subroutine mumps_sol_rhsmapinfo	(	integer, intent(in)	n,
		integer, intent(in)	nloc_rhs,
		integer, intent(in)	info23,
		integer, dimension (max(1,nloc_rhs)), intent(in)	irhs_loc,
		integer, dimension(max(1,nloc_rhs)), intent(out)	map_rhs_loc,
		integer, dimension (n), intent(in)	posinrhscomp_fwd,
		integer, intent(in)	nslaves,
		integer, intent(in)	myid_nodes,
		integer, intent(in)	comm_nodes,
		integer, dimension(60), intent(in)	icntl,
		integer, dimension(80), intent(inout)	info )

Definition at line 101 of file sol_common.F.

      IMPLICIT NONE
      INTEGER, INTENT(IN)    :: N, Nloc_RHS
      INTEGER, INTENT(IN)    :: INFO23
      INTEGER, INTENT(IN)    :: IRHS_loc   (max(1,Nloc_RHS))     
      INTEGER, INTENT(OUT)   :: MAP_RHS_loc(max(1,Nloc_RHS)) 
      INTEGER, INTENT(IN)    :: POSINRHSCOMP_FWD (N)
      INTEGER, INTENT(IN)    :: NSLAVES, MYID_NODES, COMM_NODES
      INTEGER, INTENT(INOUT) :: INFO(80)
      INTEGER, INTENT(IN)    :: ICNTL(60)
      include 'mpif.h'
      INTEGER :: I, NFS_LOC, NFS_TOT, IERR_MPI, allocok
      INTEGER, ALLOCATABLE, DIMENSION(:) :: GLOBAL_MAPPING 
      ALLOCATE(global_mapping(n), stat=allocok)
      IF (allocok .GT. 0) THEN
        info(1)=-13
        info(2)= n
      ENDIF
      CALL mpi_allreduce(mpi_in_place, allocok, 1,
     &                   mpi_integer, mpi_sum,
     &                   comm_nodes, ierr_mpi)
      IF (allocok .NE. 0) RETURN
      nfs_loc = 0
      nfs_tot = 0
      DO i = 1, n
        IF (posinrhscomp_fwd(i) .LE. 0) THEN
          global_mapping(i) = 0
        ELSE
          global_mapping(i) = myid_nodes
          nfs_loc = nfs_loc + 1
        ENDIF
      ENDDO
      IF (nfs_loc .NE. info23) THEN
        WRITE(*,*) "Internal error 1 in MUMPS_SOL_RHSMAPINFO",
     &  nfs_loc, info23
        CALL mumps_abort()
      ENDIF
      CALL mpi_allreduce(nfs_loc, nfs_tot, 1, mpi_integer,
     &                   mpi_sum, comm_nodes, ierr_mpi)
      IF (nfs_tot .NE. n) THEN
        WRITE(*,*) "Internal error 1 in MUMPS_SOL_RHSMAPINFO",
     &  nfs_loc, nfs_tot, n
        CALL mumps_abort()
      ENDIF
      CALL mpi_allreduce(mpi_in_place, global_mapping, n, mpi_integer,
     &                   mpi_sum, comm_nodes, ierr_mpi)
      DO i = 1, nloc_rhs
        IF (irhs_loc(i) .GE.1 .AND. irhs_loc(i) .LE. n) THEN
          map_rhs_loc(i) = global_mapping(irhs_loc(i))
        ELSE
          map_rhs_loc(i) = -87878787
        ENDIF
      ENDDO
      DEALLOCATE(global_mapping)
      RETURN