63
64 IMPLICIT NONE
65 INTEGER, INTENT( in ) :: N, MTYPE, NRHS, SLAVEF, LIW
66 INTEGER, INTENT( in ) :: IW(LIW)
67 INTEGER :: INFO( 80 ), KEEP(500)
68 INTEGER(8) :: KEEP8(150)
69 REAL :: DKEEP(230)
70 INTEGER, INTENT( in ) :: PROCNODE_STEPS( KEEP(28) )
71 INTEGER :: PTRICB( KEEP(28) )
72 INTEGER, INTENT( in ) :: POSINRHSCOMP_FWD(N), LRHSCOMP
73 COMPLEX, INTENT(inout):: RHSCOMP(LRHSCOMP,NRHS)
74 INTEGER, INTENT( in ) :: STEP(N), FRERE( KEEP(28) ), FILS( N ),
75 & DAD( KEEP(28) )
76 INTEGER, INTENT( inout ) :: NSTK(KEEP(28))
77 INTEGER, INTENT( in ) :: PTRIST(KEEP(28))
78 INTEGER(8), INTENT( in ) :: PTRFAC(KEEP(28))
79 INTEGER, INTENT( IN ) :: COMM, MYID
80 INTEGER, INTENT( IN ) :: LBUFR, LBUFR_BYTES
81 INTEGER :: BUFR(LBUFR)
82 INTEGER(8), INTENT(IN) :: LRHS_ROOT
83 COMPLEX :: RHS_ROOT(LRHS_ROOT)
84 INTEGER ISTEP_TO_INIV2(KEEP(71)),
85 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
86 LOGICAL, INTENT( in ) :: DO_NBSPARSE
87 INTEGER, INTENT( in ) :: LRHS_BOUNDS
88 INTEGER, INTENT( in ) :: RHS_BOUNDS(LRHS_BOUNDS)
89 LOGICAL, INTENT( in ) :: FROM_PP
90 INTEGER, INTENT( out ):: NBROOT_UNDER_L0
91 INTEGER, INTENT( in ) :: LPOOL_B_L0_OMP
92 INTEGER, INTENT( in ) :: IPOOL_B_L0_OMP
93 & ( LPOOL_B_L0_OMP )
94 INTEGER, INTENT( in ) :: L_PHYS_L0_OMP
95 INTEGER, INTENT( in ) :: PHYS_L0_OMP( L_PHYS_L0_OMP )
96 INTEGER, INTENT( in ) :: L_VIRT_L0_OMP
97 INTEGER, INTENT( in ) :: VIRT_L0_OMP( L_VIRT_L0_OMP )
98 INTEGER, INTENT( in ) :: PERM_L0_OMP( L_PHYS_L0_OMP )
99 INTEGER, INTENT( in ) :: PTR_LEAFS_L0_OMP( L_PHYS_L0_OMP + 1)
100 INTEGER, INTENT( in ) :: LL0_OMP_MAPPING
101 INTEGER, INTENT( in ) :: L0_OMP_MAPPING( LL0_OMP_MAPPING )
102 INTEGER, INTENT( in ) :: LL0_OMP_FACTORS
103 LOGICAL, INTENT( in ) :: DO_PRUN
104 LOGICAL, INTENT( in ) :: TO_PROCESS( KEEP(28) )
105 TYPE (CMUMPS_L0OMPFAC_T), INTENT(IN) ::
106 & L0_OMP_FACTORS(LL0_OMP_FACTORS)
107 INTEGER :: LASTFSSBTRSTA_P, LASTFSSBTRDYN_P
108 INTEGER :: THREAD_ID, IL0OMPFAC
109 INTEGER, ALLOCATABLE, DIMENSION(:) :: IPOOL_P
110 INTEGER, ALLOCATABLE, DIMENSION(:) :: IWCB_P
111 COMPLEX, ALLOCATABLE, DIMENSION(:) :: WCB_P
112 INTEGER :: LPOOL_P, LEAF_P, LIWCB_P
113 INTEGER(8) :: LWCB_P
114 INTEGER(8) :: POSWCB_P, PLEFTWCB_P
115 INTEGER :: POSIWCB_P
116 LOGICAL :: IS_INODE_PROCESSED_P
117 LOGICAL :: ERROR_WAS_BROADCASTED_P
118 INTEGER :: INFO_P(2), allocok
119 INTEGER :: I, VIRTUAL_TASK, PHYSICAL_TASK
120 INTEGER :: INODE, IFATH, IROOT_SBTR
121 INTEGER :: NBROOT_PROCESSED
122 INTEGER :: NEXT_TASK_DYN
123
124 INTEGER :: NBFIN_DUMMY
125 nbfin_dummy = huge(nbfin_dummy)
126 nbroot_processed = 0
127 ptricb = 0
128 next_task_dyn = keep(400)+1
129
130
131
132
133
134
135
136
137
138
139
140
141
142 thread_id = 1
143
144
145
146 lpool_p = lpool_b_l0_omp
147 info_p(1:2) = 0
148 lwcb_p = int(keep(133),8)*int(nrhs,8)
149 liwcb_p = keep(133)
150 pleftwcb_p = 1_8
151 poswcb_p = lwcb_p
152 posiwcb_p = liwcb_p
153 ALLOCATE(ipool_p(lpool_p), iwcb_p(liwcb_p), wcb_p( lwcb_p),
154 & stat=allocok)
155 IF ( allocok > 0 ) THEN
156 info_p(1) = -13
158 & info(2))
159
160 info(1) = -13
161 info(2) = info_p(2)
162
163 ENDIF
164
165 IF (info(1) .LT. 0) THEN
166 GOTO 50
167 ENDIF
168 virtual_task = thread_id
169 600 CONTINUE
170 IF (virtual_task .LT. l_virt_l0_omp) THEN
171 DO physical_task = virt_l0_omp( virtual_task ),
172 & virt_l0_omp( virtual_task + 1 ) - 1
173 leaf_p = 1
174 DO i = ptr_leafs_l0_omp( perm_l0_omp( physical_task )+1 )+1,
175 & ptr_leafs_l0_omp( perm_l0_omp( physical_task ) )
176 IF ( ipool_b_l0_omp(i) .GT. 0 ) THEN
177 ipool_p(leaf_p) = ipool_b_l0_omp(i)
178 leaf_p = leaf_p + 1
179 ENDIF
180 ENDDO
181 IF ( leaf_p .EQ. 1 ) THEN
182 WRITE(*,*) " Internal error 1 in CMUMPS_SOL_L0OMP_R",
183 & leaf_p
184 ENDIF
185 iroot_sbtr = phys_l0_omp( perm_l0_omp( physical_task ))
186 IF (do_prun) THEN
187 IF (.NOT. to_process(step(iroot_sbtr))) THEN
188 cycle
189 ENDIF
190 ENDIF
191 inode = iroot_sbtr
192 DO WHILE (inode .GT. 0)
193 lastfssbtrsta_p = inode
194 inode=fils(inode)
195 ENDDO
197 & mtype, keep, iw, liw, n, step, ptrist, fils, frere )
198 DO WHILE (leaf_p .NE.1 .AND. info_p(1) .GE. 0)
199 leaf_p = leaf_p - 1
200 inode = ipool_p(leaf_p)
201 ifath = dad(step(inode) )
202 il0ompfac = l0_omp_mapping(step(inode))
203 IF (il0ompfac .NE. thread_id) THEN
204 ENDIF
205 IF (do_prun) THEN
206 is_inode_processed_p = to_process(step(inode))
207 ELSE
208 is_inode_processed_p = .true.
209 ENDIF
210 IF ( is_inode_processed_p ) THEN
212 & lastfssbtrsta_p, lastfssbtrdyn_p,
213 & bufr, lbufr, lbufr_bytes, myid, slavef, comm,
214 & n, ipool_p, lpool_p, leaf_p, nbfin_dummy, nstk,
215 & iwcb_p, liwcb_p, wcb_p, lwcb_p,
216 & l0_omp_factors(il0ompfac)%A(1),
217 & l0_omp_factors(il0ompfac)%LA,
218 & iw, liw,
219 & nrhs, poswcb_p, pleftwcb_p, posiwcb_p,
220 & ptricb, ptrist, ptrfac, procnode_steps,
221 & fils, step, frere, dad, info_p, keep, keep8, dkeep,
222 & rhs_root, lrhs_root, mtype,
223 & rhscomp, lrhscomp, posinrhscomp_fwd,
224 & istep_to_iniv2, tab_pos_in_pere,
225 & rhs_bounds, lrhs_bounds, do_nbsparse, from_pp
226 & , error_was_broadcasted_p )
227 IF (info_p(1) .LT. 0) THEN
228
229 info(1) = info_p(1)
230 info(2) = info_p(2)
231
232 ENDIF
233 IF ( info(1) .LT. 0 ) GOTO 50
234 IF (error_was_broadcasted_p) THEN
235 WRITE(*,*) " Internal error 2 in CMUMPS_SOL_L0OMP_R",
236 & error_was_broadcasted_p
237 ENDIF
238 ENDIF
239 IF ( ifath .EQ. 0 ) THEN
240 IF ( is_inode_processed_p ) THEN
241 nbroot_processed = nbroot_processed + 1
242 ENDIF
243 ELSE
244 ptricb(step(inode)) = 0
245 IF (ifath .NE. 0) THEN
246 IF ( inode .NE. iroot_sbtr ) THEN
247 IF ( is_inode_processed_p ) THEN
248 nstk(step(ifath)) = nstk(step(ifath)) - 1
249 ENDIF
250 IF (nstk(step(ifath)) .EQ. 0 .OR.
251 & nstk(step(ifath)) .EQ. -1 ) THEN
252 ipool_p( leaf_p ) = ifath
253 leaf_p = leaf_p + 1
254 IF (do_prun) THEN
255 nstk(step(ifath)) = huge(nstk(step(ifath)))
256 ENDIF
257 ENDIF
258 ELSE
259 IF ( is_inode_processed_p ) THEN
260
261 nstk(step(ifath)) = nstk(step(ifath)) - 1
262
263 ENDIF
264 ENDIF
265 ENDIF
266 ENDIF
267 ENDDO
268 ENDDO
269
270 virtual_task = next_task_dyn
271 next_task_dyn = next_task_dyn + 1
272
273 GOTO 600
274 ENDIF
275 50 CONTINUE
276 IF (allocated(ipool_p)) DEALLOCATE(ipool_p)
277 IF (allocated(iwcb_p)) DEALLOCATE(iwcb_p)
278 IF (allocated(wcb_p)) DEALLOCATE(wcb_p)
279#if defined(WORKAROUNDINTELILP64OPENMPLIMITATION)
280
281#else
282
283#endif
284
285 nbroot_under_l0 = nbroot_processed
286 RETURN
subroutine cmumps_solve_node_fwd(inode, lastfsl0sta, lastfsl0dyn, bufr, lbufr, lbufr_bytes, myid, slavef, comm, n, ipool, lpool, leaf, nbfin, nstk_s, iwcb, liwcb, wcb, lwcb, a, la, iw, liw, nrhs, poswcb, pleftwcb, posiwcb, ptricb, ptrist, ptrfac, procnode_steps, fils, step, frere, dad, info, keep, keep8, dkeep, rhs_root, lrhs_root, mtype, rhscomp, lrhscomp, posinrhscomp_fwd istep_to_iniv2, tab_pos_in_pere, rhs_bounds, lrhs_bounds, do_nbsparse, from_pp, error_was_broadcasted)
subroutine mumps_compute_lastfs_dyn(inode, lastfssbtr_dyn, mtype, keep, iw, liw, n, step, ptrist, fils, frere)