OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
smumps_sol_l0omp_m Module Reference

Functions/Subroutines

subroutine smumps_sol_l0omp_li (k400)
subroutine smumps_sol_l0omp_ld (k400)
subroutine smumps_sol_l0omp_r (n, mtype, nrhs, liw, iw, ptricb, rhscomp, lrhscomp, posinrhscomp_fwd, step, frere, dad, fils, nstk, ptrist, ptrfac, info, keep, keep8, dkeep, procnode_steps, slavef, comm, myid, bufr, lbufr, lbufr_bytes, rhs_root, lrhs_root, istep_to_iniv2, tab_pos_in_pere, rhs_bounds, lrhs_bounds, do_nbsparse, from_pp, nbroot_under_l0, lpool_b_l0_omp, ipool_b_l0_omp, l_virt_l0_omp, virt_l0_omp, l_phys_l0_omp, phys_l0_omp, perm_l0_omp, ptr_leafs_l0_omp, l0_omp_mapping, ll0_omp_mapping, l0_omp_factors, ll0_omp_factors, do_prun, to_process)
subroutine smumps_sol_l0omp_s (n, mtype, nrhs, liw, iw, ptricb, ptracb, rhscomp, lrhscomp, posinrhscomp_bwd, step, frere, fils, ne_steps, ptrist, ptrfac, info, keep, keep8, dkeep, procnode_steps, slavef, comm, myid, bufr, lbufr, lbufr_bytes, rhs_root, lrhs_root, istep_to_iniv2, tab_pos_in_pere, panel_pos, lpanel_pos, prun_below_bwd, to_process, size_to_process, rhs_bounds, lrhs_bounds, do_nbsparse, from_pp, lpool_b_l0_omp, l_virt_l0_omp, virt_l0_omp, l_phys_l0_omp, phys_l0_omp, perm_l0_omp, ptr_leafs_l0_omp, l0_omp_mapping, ll0_omp_mapping, l0_omp_factors, ll0_omp_factors)

Variables

integer, parameter nb_lock_max = 18

Function/Subroutine Documentation

◆ smumps_sol_l0omp_ld()

subroutine smumps_sol_l0omp_m::smumps_sol_l0omp_ld ( integer, intent(in) k400)

Definition at line 33 of file ssol_omp_m.F.

34!$ USE OMP_LIB, ONLY : OMP_DESTROY_LOCK
35 IMPLICIT NONE
36 INTEGER, INTENT(IN) :: K400
37!$ INTEGER :: I
38!$ IF (K400 .GT. 0) THEN
39!$ DO I = 1, min(NB_LOCK_MAX,K400)
40!$ CALL OMP_DESTROY_LOCK(LOCK_FOR_SCATTER(I))
41!$ ENDDO
42!$ DEALLOCATE(LOCK_FOR_SCATTER)
43!$ ENDIF
44 RETURN

◆ smumps_sol_l0omp_li()

subroutine smumps_sol_l0omp_m::smumps_sol_l0omp_li ( integer, intent(in) k400)

Definition at line 20 of file ssol_omp_m.F.

21!$ USE OMP_LIB, ONLY: OMP_INIT_LOCK
22 IMPLICIT NONE
23 INTEGER, INTENT(IN) :: K400
24!$ INTEGER :: I
25!$ IF (K400 .GT. 0) THEN
26!$ ALLOCATE(LOCK_FOR_SCATTER(min(NB_LOCK_MAX,K400)))
27!$ DO I = 1, min(NB_LOCK_MAX,K400)
28!$ CALL OMP_INIT_LOCK(LOCK_FOR_SCATTER(I))
29!$ ENDDO
30!$ ENDIF
31 RETURN

◆ smumps_sol_l0omp_r()

subroutine smumps_sol_l0omp_m::smumps_sol_l0omp_r ( integer, intent(in) n,
integer, intent(in) mtype,
integer, intent(in) nrhs,
integer, intent(in) liw,
integer, dimension(liw), intent(in) iw,
integer, dimension( keep(28) ) ptricb,
real, dimension(lrhscomp,nrhs), intent(inout) rhscomp,
integer, intent(in) lrhscomp,
integer, dimension(n), intent(in) posinrhscomp_fwd,
integer, dimension(n), intent(in) step,
integer, dimension( keep(28) ), intent(in) frere,
integer, dimension( keep(28) ), intent(in) dad,
integer, dimension( n ), intent(in) fils,
integer, dimension(keep(28)), intent(inout) nstk,
integer, dimension(keep(28)), intent(in) ptrist,
integer(8), dimension(keep(28)), intent(in) ptrfac,
integer, dimension( 80 ) info,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
real, dimension(230) dkeep,
integer, dimension( keep(28) ), intent(in) procnode_steps,
integer, intent(in) slavef,
integer, intent(in) comm,
integer, intent(in) myid,
integer, dimension(lbufr) bufr,
integer, intent(in) lbufr,
integer, intent(in) lbufr_bytes,
real, dimension(lrhs_root) rhs_root,
integer(8), intent(in) lrhs_root,
integer, dimension(keep(71)) istep_to_iniv2,
integer, dimension(slavef+2,max(1,keep(56))) tab_pos_in_pere,
integer, dimension(lrhs_bounds), intent(in) rhs_bounds,
integer, intent(in) lrhs_bounds,
logical, intent(in) do_nbsparse,
logical, intent(in) from_pp,
integer, intent(out) nbroot_under_l0,
integer, intent(in) lpool_b_l0_omp,
integer, dimension ( lpool_b_l0_omp ), intent(in) ipool_b_l0_omp,
integer, intent(in) l_virt_l0_omp,
integer, dimension( l_virt_l0_omp ), intent(in) virt_l0_omp,
integer, intent(in) l_phys_l0_omp,
integer, dimension( l_phys_l0_omp ), intent(in) phys_l0_omp,
integer, dimension( l_phys_l0_omp ), intent(in) perm_l0_omp,
integer, dimension( l_phys_l0_omp + 1), intent(in) ptr_leafs_l0_omp,
integer, dimension( ll0_omp_mapping ), intent(in) l0_omp_mapping,
integer, intent(in) ll0_omp_mapping,
type (smumps_l0ompfac_t), dimension(ll0_omp_factors), intent(in) l0_omp_factors,
integer, intent(in) ll0_omp_factors,
logical, intent(in) do_prun,
logical, dimension( keep(28) ), intent(in) to_process )

Definition at line 46 of file ssol_omp_m.F.

62 USE smumps_struc_def, ONLY : smumps_l0ompfac_t
63!$ USE OMP_LIB
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 REAL, 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 REAL :: 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 (SMUMPS_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 REAL, 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!$ INTEGER :: NOMP_SAVE
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!$OMP PARALLEL
130!$OMP& SHARED ( NEXT_TASK_DYN, IPOOL_B_L0_OMP,
131!$OMP& LPOOL_B_L0_OMP, NBFIN_DUMMY )
132!$OMP& PRIVATE ( THREAD_ID, IL0OMPFAC, VIRTUAL_TASK, PHYSICAL_TASK,
133!$OMP& IPOOL_P, LPOOL_P, LEAF_P,
134!$OMP& LIWCB_P, LWCB_P, IWCB_P, WCB_P,
135!$OMP& PLEFTWCB_P, POSWCB_P, POSIWCB_P,
136!$OMP& LASTFSSBTRSTA_P, LASTFSSBTRDYN_P,
137!$OMP& INODE, IROOT_SBTR, IFATH,
138!$OMP& IS_INODE_PROCESSED_P,
139!$OMP& INFO_P, ERROR_WAS_BROADCASTED_P, NOMP_SAVE, allocok )
140!$OMP& REDUCTION( + : NBROOT_PROCESSED )
141!$ NOMP_SAVE = omp_get_max_threads()
142 thread_id = 1
143!$ THREAD_ID = OMP_GET_THREAD_NUM() + 1
144!$OMP BARRIER
145!$ CALL omp_set_num_threads(1)
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
157 CALL mumps_seti8toi4(lpool_p + liwcb_p + lwcb_p,
158 & info(2))
159!$OMP CRITICAL(critical_info)
160 info(1) = -13
161 info(2) = info_p(2)
162!$OMP END CRITICAL(critical_info)
163 ENDIF
164!$OMP BARRIER
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 SMUMPS_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
196 CALL mumps_compute_lastfs_dyn( iroot_sbtr, lastfssbtrdyn_p,
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
211 CALL smumps_solve_node_fwd( inode,
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!$OMP CRITICAL(critical_info)
229 info(1) = info_p(1)
230 info(2) = info_p(2)
231!$OMP END CRITICAL(critical_info)
232 ENDIF
233 IF ( info(1) .LT. 0 ) GOTO 50
234 IF (error_was_broadcasted_p) THEN
235 WRITE(*,*) " Internal error 2 in SMUMPS_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!$OMP ATOMIC UPDATE
261 nstk(step(ifath)) = nstk(step(ifath)) - 1
262!$OMP END ATOMIC
263 ENDIF
264 ENDIF
265 ENDIF
266 ENDIF
267 ENDDO
268 ENDDO
269!$OMP ATOMIC CAPTURE
270 virtual_task = next_task_dyn
271 next_task_dyn = next_task_dyn + 1
272!$OMP END ATOMIC
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!$ CALL omp_set_num_threads(int(NOMP_SAVE,4))
281#else
282!$ CALL omp_set_num_threads(NOMP_SAVE)
283#endif
284!$OMP END PARALLEL
285 nbroot_under_l0 = nbroot_processed
286 RETURN
smumps_struc_def
Definition smumps_struc_def.F:14
mumps_compute_lastfs_dyn
subroutine mumps_compute_lastfs_dyn(inode, lastfssbtr_dyn, mtype, keep, iw, liw, n, step, ptrist, fils, frere)
Definition sol_common.F:163
smumps_solve_node_fwd
subroutine smumps_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)
Definition ssol_fwd_aux.F:365
mumps_seti8toi4
subroutine mumps_seti8toi4(i8, i)
Definition tools_common.F:843

◆ smumps_sol_l0omp_s()

subroutine smumps_sol_l0omp_m::smumps_sol_l0omp_s ( integer, intent(in) n,
integer, intent(in) mtype,
integer, intent(in) nrhs,
integer, intent(in) liw,
integer, dimension(liw), intent(in) iw,
integer, dimension( keep(28) ) ptricb,
integer(8), dimension( keep(28) ) ptracb,
real, dimension(lrhscomp,nrhs), intent(inout) rhscomp,
integer, intent(in) lrhscomp,
integer, dimension(n), intent(in) posinrhscomp_bwd,
integer, dimension(n), intent(in) step,
integer, dimension( keep(28) ), intent(in) frere,
integer, dimension( n ), intent(in) fils,
integer, dimension(keep(28)), intent(inout) ne_steps,
integer, dimension(keep(28)), intent(in) ptrist,
integer(8), dimension(keep(28)), intent(in) ptrfac,
integer, dimension( 80 ) info,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
real, dimension(230) dkeep,
integer, dimension( keep(28) ), intent(in) procnode_steps,
integer, intent(in) slavef,
integer, intent(in) comm,
integer, intent(in) myid,
integer, dimension(lbufr) bufr,
integer, intent(in) lbufr,
integer, intent(in) lbufr_bytes,
real, dimension(lrhs_root) rhs_root,
integer(8), intent(in) lrhs_root,
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_bwd,
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, intent(in) lpool_b_l0_omp,
integer, intent(in) l_virt_l0_omp,
integer, dimension( l_virt_l0_omp ), intent(in) virt_l0_omp,
integer, intent(in) l_phys_l0_omp,
integer, dimension( l_phys_l0_omp ), intent(in) phys_l0_omp,
integer, dimension( l_phys_l0_omp ), intent(in) perm_l0_omp,
integer, dimension( l_phys_l0_omp + 1), intent(in) ptr_leafs_l0_omp,
integer, dimension( ll0_omp_mapping ), intent(in) l0_omp_mapping,
integer, intent(in) ll0_omp_mapping,
type (smumps_l0ompfac_t), dimension(ll0_omp_factors), intent(in) l0_omp_factors,
integer, intent(in) ll0_omp_factors )

Definition at line 288 of file ssol_omp_m.F.

299 USE smumps_struc_def, ONLY : smumps_l0ompfac_t
300 USE omp_lib
301 IMPLICIT NONE
302 INTEGER, INTENT( in ) :: N, MTYPE, NRHS, SLAVEF, LIW
303 INTEGER, INTENT( in ) :: IW(LIW)
304 INTEGER :: INFO( 80 ), KEEP(500)
305 INTEGER(8) :: KEEP8(150)
306 REAL :: DKEEP(230)
307 INTEGER, INTENT( in ) :: PROCNODE_STEPS( KEEP(28) )
308 INTEGER :: PTRICB( KEEP(28) )
309 INTEGER(8) :: PTRACB( KEEP(28) )
310 INTEGER, INTENT( in ) :: POSINRHSCOMP_BWD(N), LRHSCOMP
311 REAL, INTENT(inout):: RHSCOMP(LRHSCOMP,NRHS)
312 INTEGER, INTENT( in ) :: STEP(N), FRERE( KEEP(28) ), FILS( N )
313 INTEGER, INTENT( inout ) :: NE_STEPS(KEEP(28))
314 INTEGER, INTENT( in ) :: PTRIST(KEEP(28))
315 INTEGER(8), INTENT( in ) :: PTRFAC(KEEP(28))
316 INTEGER, INTENT( IN ) :: COMM, MYID
317 INTEGER, INTENT( IN ) :: LBUFR, LBUFR_BYTES
318 INTEGER :: BUFR(LBUFR)
319 INTEGER(8), INTENT(IN) :: LRHS_ROOT
320 REAL :: RHS_ROOT(LRHS_ROOT)
321 INTEGER ISTEP_TO_INIV2(KEEP(71)),
322 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
323 INTEGER :: LPANEL_POS
324 INTEGER :: PANEL_POS(LPANEL_POS)
325 LOGICAL, INTENT( in ) :: DO_NBSPARSE
326 INTEGER, INTENT( in ) :: LRHS_BOUNDS
327 INTEGER, INTENT( in ) :: RHS_BOUNDS(LRHS_BOUNDS)
328 LOGICAL, INTENT( in ) :: PRUN_BELOW_BWD
329 INTEGER, INTENT( in ) :: SIZE_TO_PROCESS
330 LOGICAL, INTENT( in ) :: TO_PROCESS(SIZE_TO_PROCESS)
331 LOGICAL, INTENT( in ) :: FROM_PP
332 INTEGER, INTENT( in ) :: LPOOL_B_L0_OMP
333 INTEGER, INTENT( in ) :: L_PHYS_L0_OMP
334 INTEGER, INTENT( in ) :: PHYS_L0_OMP( L_PHYS_L0_OMP )
335 INTEGER, INTENT( in ) :: L_VIRT_L0_OMP
336 INTEGER, INTENT( in ) :: VIRT_L0_OMP( L_VIRT_L0_OMP )
337 INTEGER, INTENT( in ) :: PERM_L0_OMP( L_PHYS_L0_OMP )
338 INTEGER, INTENT( in ) :: PTR_LEAFS_L0_OMP( L_PHYS_L0_OMP + 1)
339 INTEGER, INTENT( in ) :: LL0_OMP_MAPPING
340 INTEGER, INTENT( in ) :: L0_OMP_MAPPING( LL0_OMP_MAPPING )
341 INTEGER, INTENT( in ) :: LL0_OMP_FACTORS
342 TYPE (SMUMPS_L0OMPFAC_T), INTENT(IN) ::
343 & L0_OMP_FACTORS(LL0_OMP_FACTORS)
344 INTEGER :: THREAD_ID, IL0OMPFAC
345 INTEGER, ALLOCATABLE, DIMENSION(:) :: IPOOL_P
346 INTEGER, ALLOCATABLE, DIMENSION(:) :: IWCB_P
347 REAL, ALLOCATABLE, DIMENSION(:) :: WCB_P
348 REAL, ALLOCATABLE, DIMENSION(:) :: W2_P
349 INTEGER, ALLOCATABLE, DIMENSION(:) :: PANEL_POS_P
350 INTEGER :: LPOOL_P, IIPOOL_P, LIWCB_P, LPANEL_POS_P
351 INTEGER :: MYLEAF_LEFT_HUGE_P
352 INTEGER(8) :: LWCB_P
353 INTEGER(8) :: POSWCB_P, PLEFTWCB_P
354 INTEGER :: POSIWCB_P
355 LOGICAL :: DO_MCAST2_TERMBWD_P
356 LOGICAL :: ERROR_WAS_BROADCASTED_P
357 INTEGER :: INFO_P(2), allocok
358 INTEGER :: VIRTUAL_TASK, PHYSICAL_TASK
359 INTEGER :: INODE
360 INTEGER :: NEXT_TASK_DYN
361!$ INTEGER :: NOMP_SAVE
362 INTEGER :: NBFIN_DUMMY
363 LOGICAL, ALLOCATABLE, DIMENSION(:) :: DEJA_SEND_DUMMY
364 nbfin_dummy = huge(nbfin_dummy)
365 ALLOCATE(deja_send_dummy( 0:slavef-1 ), stat=allocok)
366 if(allocok.ne.0) then
367 WRITE(6,*) ' Allocation error of DEJA_SEND_DUMMY in '
368 & //'routine SMUMPS_SOL_S '
369 info(1)=-13
370 info(2)=slavef
371 GOTO 100
372 endif
373 ptricb = 0
374 next_task_dyn = keep(400)+1
375!$OMP PARALLEL
376!$OMP& SHARED ( NEXT_TASK_DYN, LPOOL_B_L0_OMP,
377!$OMP& NBFIN_DUMMY, DEJA_SEND_DUMMY )
378!$OMP& PRIVATE ( THREAD_ID, IL0OMPFAC, VIRTUAL_TASK, PHYSICAL_TASK,
379!$OMP& IPOOL_P, LPOOL_P, IIPOOL_P, MYLEAF_LEFT_HUGE_P,
380!$OMP& LIWCB_P, LWCB_P, IWCB_P, WCB_P, W2_P, LPANEL_POS_P,
381!$OMP& PANEL_POS_P,
382!$OMP& PLEFTWCB_P, POSWCB_P, POSIWCB_P,
383!$OMP& INODE,
384!$OMP& INFO_P, DO_MCAST2_TERMBWD_P,
385!$OMP& ERROR_WAS_BROADCASTED_P, NOMP_SAVE, allocok )
386!$ NOMP_SAVE = omp_get_max_threads()
387 thread_id = 1
388!$ THREAD_ID = OMP_GET_THREAD_NUM() + 1
389!$OMP BARRIER
390!$ CALL omp_set_num_threads(1)
391 lpool_p = lpool_b_l0_omp
392 info_p(1:2) = 0
393 lwcb_p = int(keep(133),8)*int(nrhs,8)
394 liwcb_p = keep(133)
395 pleftwcb_p = 1_8
396 poswcb_p = lwcb_p
397 posiwcb_p = liwcb_p
398 IF (keep(201).EQ.1) THEN
399 lpanel_pos_p = keep(228)+1
400 CALL mumps_abort()
401 ELSE
402 lpanel_pos_p = 1
403 ENDIF
404 ALLOCATE(ipool_p(lpool_p), iwcb_p(liwcb_p), wcb_p( lwcb_p),
405 & w2_p(keep(133)), panel_pos_p(lpanel_pos_p), stat=allocok)
406 IF ( allocok > 0 ) THEN
407 info_p(1) = -13
408 CALL mumps_seti8toi4(lpool_p + liwcb_p + lwcb_p +
409 & keep(133)+lpanel_pos_p, info(2))
410!$OMP CRITICAL(critical_info)
411 info(1) = -13
412 info(2) = info_p(2)
413!$OMP END CRITICAL(critical_info)
414 ENDIF
415!$OMP BARRIER
416 IF (info(1) .LT. 0) THEN
417 GOTO 50
418 ENDIF
419 virtual_task = thread_id
420 600 CONTINUE
421 IF (virtual_task .LT. l_virt_l0_omp) THEN
422 DO physical_task = virt_l0_omp( virtual_task ),
423 & virt_l0_omp( virtual_task + 1 ) - 1
424 inode = phys_l0_omp( perm_l0_omp( physical_task ) )
425 ipool_p(1) = inode
426 iipool_p = 2
427 myleaf_left_huge_p = huge(myleaf_left_huge_p)
428 IF ( prun_below_bwd ) THEN
429 IF ( .NOT. to_process(step(inode)) ) THEN
430 cycle
431 ENDIF
432 ENDIF
433 DO WHILE (iipool_p .NE.1 .AND. info_p(1) .GE. 0)
434 iipool_p = iipool_p - 1
435 inode = ipool_p(iipool_p)
436 il0ompfac = l0_omp_mapping(step(inode))
437 IF (il0ompfac .NE. thread_id) THEN
438 ENDIF
439 CALL smumps_solve_node_bwd( inode, n, ipool_p, lpool_p,
440 & iipool_p, nbfin_dummy, l0_omp_factors(il0ompfac)%A(1),
441 & l0_omp_factors(il0ompfac)%LA, iw, liw,
442 & wcb_p, lwcb_p, nrhs, poswcb_p, pleftwcb_p, posiwcb_p,
443 & rhscomp, lrhscomp, posinrhscomp_bwd,
444 & ptricb, ptracb, iwcb_p, liwcb_p, w2_p, ne_steps, step,
445 & frere, fils, ptrist, ptrfac, myleaf_left_huge_p, info_p,
446 & procnode_steps,
447 & deja_send_dummy,
448 & slavef, comm, myid, bufr, lbufr, lbufr_bytes,
449 & keep, keep8, dkeep, rhs_root, lrhs_root, mtype,
450 & istep_to_iniv2, tab_pos_in_pere, panel_pos_p, lpanel_pos_p,
451 & prun_below_bwd, to_process, size_to_process,
452 & rhs_bounds, lrhs_bounds, do_nbsparse, from_pp
453 & , error_was_broadcasted_p
454 & , do_mcast2_termbwd_p
455 & )
456 IF (info_p(1) .LT. 0) THEN
457!$OMP CRITICAL(critical_info)
458 info(1) = info_p(1)
459 info(2) = info_p(2)
460!$OMP END CRITICAL(critical_info)
461 ENDIF
462 IF ( info(1) .LT. 0 ) GOTO 50
463 IF (error_was_broadcasted_p) THEN
464 WRITE(*,*) " Internal error 1 in SMUMPS_SOL_L0OMP_R",
465 & error_was_broadcasted_p
466 ENDIF
467 IF (do_mcast2_termbwd_p) THEN
468 WRITE(*,*) " Internal error 2 in SMUMPS_SOL_L0OMP_R",
469 & do_mcast2_termbwd_p
470 ENDIF
471 ENDDO
472 ENDDO
473!$OMP ATOMIC CAPTURE
474 virtual_task = next_task_dyn
475 next_task_dyn = next_task_dyn + 1
476!$OMP END ATOMIC
477 GOTO 600
478 ENDIF
479 50 CONTINUE
480 IF (allocated(ipool_p)) DEALLOCATE(ipool_p)
481 IF (allocated(iwcb_p)) DEALLOCATE(iwcb_p)
482 IF (allocated(wcb_p)) DEALLOCATE(wcb_p)
483 IF (allocated(w2_p)) DEALLOCATE(w2_p)
484 IF (allocated(panel_pos_p)) DEALLOCATE(panel_pos_p)
485#if defined(WORKAROUNDINTELILP64OPENMPLIMITATION)
486!$ CALL omp_set_num_threads(int(NOMP_SAVE,4))
487#else
488!$ CALL omp_set_num_threads(NOMP_SAVE)
489#endif
490!$OMP END PARALLEL
491 100 CONTINUE
492 IF (allocated(deja_send_dummy)) DEALLOCATE(deja_send_dummy)
493 RETURN
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
smumps_solve_node_bwd
subroutine smumps_solve_node_bwd(inode, n, ipool, lpool, iipool, nbfinf, a, la, 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)
Definition ssol_bwd_aux.F:32

Variable Documentation

◆ nb_lock_max

integer, parameter smumps_sol_l0omp_m::nb_lock_max = 18

Definition at line 16 of file ssol_omp_m.F.

16 INTEGER, PARAMETER :: NB_LOCK_MAX = 18