csol_bwd.F File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine

cmumps_sol_s (n, a, la, iw, liw, w, lwc, nrhs, rhscomp, lrhscomp, posinrhscomp_bwd, ptricb, ptracb, iwcb, liww, w2, ne_steps, step, frere, dad, fils, ipool, lpool, ptrist, ptrfac, myleaf, myroot, icntl, info, procnode_steps, slavef, comm, myid, bufr, lbufr, lbufr_bytes, keep, keep8, dkeep, rhs_root, lrhs_root, mtype, istep_to_iniv2, tab_pos_in_pere, panel_pos, lpanel_pos, prun_below, to_process, size_to_process, rhs_bounds, lrhs_bounds, do_nbsparse, from_pp, l0_omp_mapping, ll0_omp_mapping, l0_omp_factors, ll0_omp_factors)

Function/Subroutine Documentation

cmumps_sol_s()

subroutine cmumps_sol_s	(	integer, intent(in)	n,
		complex, dimension(la)	a,
		integer(8), intent(in)	la,
		integer, dimension(liw)	iw,
		integer, intent(in)	liw,
		complex, dimension(lwc)	w,
		integer(8), intent(in)	lwc,
		integer	nrhs,
		complex, dimension(lrhscomp,nrhs)	rhscomp,
		integer	lrhscomp,
		integer, dimension(n)	posinrhscomp_bwd,
		integer, dimension(keep(28))	ptricb,
		integer(8), dimension(keep(28))	ptracb,
		integer, dimension(liww)	iwcb,
		integer, intent(in)	liww,
		complex, dimension(keep(133))	w2,
		integer, dimension(keep(28))	ne_steps,
		integer, dimension(n)	step,
		integer, dimension(keep(28))	frere,
		integer, dimension(keep(28))	dad,
		integer, dimension(n)	fils,
		integer, dimension(lpool)	ipool,
		integer, intent(in)	lpool,
		integer, dimension(keep(28))	ptrist,
		integer(8), dimension(keep(28))	ptrfac,
		integer, intent(in)	myleaf,
		integer, intent(in)	myroot,
		integer, dimension(60)	icntl,
		integer, dimension(80)	info,
		integer, dimension(keep(28))	procnode_steps,
		integer, intent(in)	slavef,
		integer, intent(in)	comm,
		integer, intent(in)	myid,
		integer, dimension(lbufr)	bufr,
		integer	lbufr,
		integer	lbufr_bytes,
		integer, dimension( 500 )	keep,
		integer(8), dimension(150)	keep8,
		real, dimension(230), intent(inout)	dkeep,
		complex, dimension( lrhs_root )	rhs_root,
		integer(8), intent(in)	lrhs_root,
		integer	mtype,
		integer, dimension(keep(71))	istep_to_iniv2,
		integer, dimension(slavef+2,max(1,keep(56)))	tab_pos_in_pere,
		integer, dimension(lpanel_pos)	panel_pos,
		integer	lpanel_pos,
		logical, intent(in)	prun_below,
		logical, dimension(size_to_process), intent(in)	to_process,
		integer, intent(in)	size_to_process,
		integer, dimension(lrhs_bounds), intent(in)	rhs_bounds,
		integer, intent(in)	lrhs_bounds,
		logical, intent(in)	do_nbsparse,
		logical, intent(in)	from_pp,
		integer, dimension( ll0_omp_mapping ), intent(in)	l0_omp_mapping,
		integer, intent(in)	ll0_omp_mapping,
		type (cmumps_l0ompfac_t), dimension(ll0_omp_factors), intent(in)	l0_omp_factors,
		integer, intent(in)	ll0_omp_factors )

Definition at line 14 of file csol_bwd.F.

      USE cmumps_static_ptr_m, ONLY : cmumps_set_static_ptr,
     &                                cmumps_get_tmp_ptr
      USE cmumps_struc_def, ONLY : cmumps_l0ompfac_t
      IMPLICIT NONE
      INTEGER MTYPE
      INTEGER(8), intent(in) :: LA
      INTEGER(8), intent(in) :: LWC
      INTEGER, intent(in) :: N,LIW,LIWW,LPOOL
      INTEGER, intent(in) :: SLAVEF,MYLEAF,MYROOT,COMM,MYID
      INTEGER KEEP( 500 )
      INTEGER(8) KEEP8(150)
      REAL, INTENT(INOUT) :: DKEEP(230)
      INTEGER PROCNODE_STEPS(KEEP(28))
      INTEGER NE_STEPS(KEEP(28))
      INTEGER IPOOL(LPOOL)
      INTEGER LPANEL_POS
      INTEGER PANEL_POS(LPANEL_POS)
      INTEGER ICNTL(60), INFO(80)
      INTEGER PTRIST(KEEP(28)),
     &        PTRICB(KEEP(28))
      INTEGER(8) :: PTRACB(KEEP(28))
      INTEGER(8) :: PTRFAC(KEEP(28))
      INTEGER NRHS
      COMPLEX A(LA), W(LWC)
      COMPLEX W2(KEEP(133))
      INTEGER IW(LIW),IWCB(LIWW)
      INTEGER STEP(N), FRERE(KEEP(28)),DAD(KEEP(28)),FILS(N)
      INTEGER LBUFR, LBUFR_BYTES
      INTEGER BUFR(LBUFR)
      INTEGER ISTEP_TO_INIV2(KEEP(71)), 
     &        TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
      INTEGER LRHSCOMP, POSINRHSCOMP_BWD(N)
      COMPLEX RHSCOMP(LRHSCOMP,NRHS)
      INTEGER(8), intent(in) :: LRHS_ROOT
      COMPLEX RHS_ROOT( LRHS_ROOT )
      LOGICAL, INTENT(in) :: PRUN_BELOW
      INTEGER, intent(in)           :: SIZE_TO_PROCESS
      LOGICAL, intent(in)           :: TO_PROCESS(SIZE_TO_PROCESS)
      LOGICAL, intent(in) :: DO_NBSPARSE
      INTEGER, intent(in) :: LRHS_BOUNDS
      INTEGER, intent(in) :: RHS_BOUNDS(LRHS_BOUNDS)
      LOGICAL, intent(in) :: FROM_PP
      INTEGER, INTENT( in ) :: LL0_OMP_MAPPING, LL0_OMP_FACTORS
      INTEGER, INTENT( in ) :: L0_OMP_MAPPING( LL0_OMP_MAPPING )
      TYPE (CMUMPS_L0OMPFAC_T), INTENT(IN) ::
     &                        L0_OMP_FACTORS(LL0_OMP_FACTORS)
      include 'mpif.h'
      include 'mumps_tags.h'
      LOGICAL FLAG
      COMPLEX, DIMENSION(:), POINTER :: A_PTR
      INTEGER(8) :: LA_PTR
      INTEGER :: UNDERL0MAP 
      INTEGER(8) :: POSWCB, PLEFTW
      INTEGER POSIWCB
      INTEGER NBFINF
      INTEGER INODE
      INTEGER III,IIPOOL,MYLEAF_LEFT
      LOGICAL BLOQ
      INTEGER DUMMY(1)
      LOGICAL :: ERROR_WAS_BROADCASTED, DO_MCAST2_TERMBWD
      LOGICAL :: ALLOW_OTHERS_TO_LEAVE
      LOGICAL, DIMENSION(:), ALLOCATABLE :: DEJA_SEND
      INTEGER :: allocok
      dummy(1)=0
      keep(266)=0
      ALLOCATE(deja_send( 0:slavef-1 ), stat=allocok)
      if(allocok.ne.0) then
         WRITE(6,*) ' Allocation error of DEJA_SEND in '
     &        //'routine CMUMPS_SOL_S '
         info(1)=-13
         info(2)=slavef
      endif
      CALL mumps_propinfo( icntl, info, comm, myid )
      IF ( info(1) .LT.0 ) GOTO 340
      pleftw = 1_8
      posiwcb = liww
      poswcb = lwc
      iii = 1
      iipool = myroot + 1
      myleaf_left = myleaf
      nbfinf = slavef
      allow_others_to_leave = ( myleaf_left .EQ. 0 .AND.
     &                          keep(31) .EQ. 0 )
      allow_others_to_leave = allow_others_to_leave .OR.
     &                        keep(31) .EQ. 1
      IF (allow_others_to_leave) THEN
        CALL cmumps_mcast2(dummy, 1, mpi_integer, myid, comm, termbwd,
     &                  slavef, keep)
        nbfinf = nbfinf - 1
        IF (nbfinf .EQ. 0 .AND. myleaf_left .EQ. 0) THEN
          GOTO 340
        ENDIF
      ENDIF
      error_was_broadcasted = .false.
      do_mcast2_termbwd = .false.
      DO WHILE ( nbfinf .NE. 0 .OR. myleaf_left .NE. 0 )
        bloq = (  iii .EQ. iipool  )
        CALL cmumps_backslv_recv_and_treat( bloq, flag, bufr, lbufr,
     &     lbufr_bytes, myid, slavef, comm,
     &     n, iwcb, liww, posiwcb,
     &     w, lwc, poswcb,
     &     iipool, nbfinf, ptricb, ptracb, info,
     &     ipool, lpool, panel_pos, lpanel_pos,
     &     step,  frere, fils, procnode_steps,
     &     pleftw, keep,keep8, dkeep,
     &     ptrist, ptrfac, iw, liw, a, la, w2, myleaf_left, 
     &     nrhs, mtype, 
     &     rhscomp, lrhscomp, posinrhscomp_bwd
     &     , prun_below, to_process, size_to_process
     &     , from_pp
     &     )
        IF ( info(1) .LT. 0 ) GOTO 340 
        IF ( .NOT. flag ) THEN
          IF (iii .NE. iipool) THEN
            inode = ipool(iipool-1)
            iipool = iipool - 1
            IF (keep(400) .GT. 0 ) THEN
              underl0map = l0_omp_mapping(step(inode))
            ELSE
              underl0map = 0
            ENDIF
            IF (underl0map .EQ. 0 .OR. keep(201).GT.0) THEN
              CALL cmumps_set_static_ptr(a)
              CALL cmumps_get_tmp_ptr(a_ptr)
              la_ptr = la
            ELSE
              a_ptr => l0_omp_factors(underl0map)%A
              la_ptr = l0_omp_factors(underl0map)%LA
            ENDIF
            CALL cmumps_solve_node_bwd( inode, 
     &        n, ipool, lpool, iipool, nbfinf,
     &        a_ptr(1), la_ptr, iw, liw, w, lwc, nrhs,
     &        poswcb, pleftw, posiwcb,
     &        rhscomp, lrhscomp, posinrhscomp_bwd,
     &        ptricb, ptracb, iwcb, liww, w2, 
     &        ne_steps, step,
     &        frere, fils, ptrist, ptrfac,
     &        myleaf_left, info,
     &        procnode_steps, deja_send,
     &        slavef, comm, myid, bufr, lbufr, lbufr_bytes,
     &        keep,keep8, dkeep, rhs_root, lrhs_root, mtype,
     &        istep_to_iniv2, tab_pos_in_pere, panel_pos, lpanel_pos,
     &        prun_below, to_process, size_to_process
     &        , rhs_bounds, lrhs_bounds, do_nbsparse, from_pp
     &        , error_was_broadcasted
     &        , do_mcast2_termbwd
     &        )
            IF ( info(1) .LT. 0 ) THEN
              IF (.NOT. error_was_broadcasted) THEN
                IF (nbfinf .EQ. 0 ) THEN
                  CALL cmumps_bdc_error( myid, slavef, comm, keep )
                ENDIF
              ENDIF
            ENDIF
            IF (do_mcast2_termbwd) THEN
              CALL cmumps_mcast2( dummy, 1,  mpi_integer, myid, comm,
     &                            termbwd, slavef, keep )
            ENDIF
          ENDIF                   
        END IF                    
      ENDDO
  340 CONTINUE
      IF (ALLOCATED(deja_send)) DEALLOCATE(deja_send)
      RETURN