OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
zfac_lastrtnelind.F File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine zmumps_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

◆ zmumps_last_rtnelind()

subroutine zmumps_last_rtnelind ( integer comm_load,
integer ass_irecv,
type (zmumps_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(kind=8), 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(kind=8), 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(kind=8), dimension( keep8(26) ) dblarr,
integer, dimension( 60 ) icntl,
integer, dimension( 500 ) keep,
integer(8), dimension(150) keep8,
double precision, 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 zfac_lastrtnelind.F.

33 USE zmumps_buf
34 USE zmumps_struc_def, ONLY : zmumps_root_struc
35 IMPLICIT NONE
36 include 'mpif.h'
37 TYPE (ZMUMPS_ROOT_STRUC) :: root
38 INTEGER IROOT
39 INTEGER ICNTL( 60 ), KEEP( 500 )
40 INTEGER(8) KEEP8(150)
41 DOUBLE PRECISION DKEEP(230)
42 INTEGER COMM_LOAD, ASS_IRECV
43 INTEGER LBUFR, LBUFR_BYTES
44 INTEGER BUFR( LBUFR )
45 INTEGER(8) :: POSFAC,IPTRLU, LRLU, LRLUS
46 INTEGER IWPOS, IWPOSCB
47 INTEGER(8) :: LA
48 INTEGER N, LIW
49 INTEGER IW( LIW )
50 COMPLEX(kind=8) A( LA )
51 INTEGER, intent(in) :: LRGROUPS(N)
52 INTEGER(8) :: PTRAST(KEEP(28))
53 INTEGER(8) :: PTRFAC(KEEP(28))
54 INTEGER(8) :: PAMASTER(KEEP(28))
55 INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28))
56 INTEGER STEP(N), PIMASTER(KEEP(28))
57 INTEGER COMP
58 INTEGER NSTK_S( KEEP(28) ), PROCNODE_STEPS( KEEP(28) )
59 INTEGER PERM(N)
60 INTEGER IFLAG, IERROR, COMM
61 INTEGER LPTRAR, NELT
62 INTEGER FRTPTR( N+1 ), FRTELT( NELT )
63 INTEGER LPOOL, LEAF
64 INTEGER IPOOL( LPOOL )
65 INTEGER MYID, SLAVEF, NBFIN
66 INTEGER ISTEP_TO_INIV2(KEEP(71)),
67 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
68 DOUBLE PRECISION OPASSW, OPELIW
69 INTEGER ITLOC( N+KEEP(253) ), FILS( N ), DAD( KEEP(28) )
70 COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255))
71 INTEGER(8), INTENT(IN) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR )
72 INTEGER ND(KEEP(28)), FRERE(KEEP(28))
73 COMPLEX(kind=8) DBLARR( KEEP8(26) )
74 INTEGER INTARR( KEEP8(27) )
75 INTEGER I, NELIM, NB_CONTRI_GLOBAL, NUMORG,
76 & NFRONT, IROW, JCOL, PDEST, HF, IOLDPS,
77 & IN, DEB_ROW, ILOC_ROW, IFSON, ILOC_COL,
78 & IPOS_SON, NELIM_SON, NSLAVES_SON, HS,
79 & IROW_SON, ICOL_SON, ISLAVE, IERR,
80 & NELIM_SENT, IPOS_STATREC, TYPE_SON
81 INTEGER MUMPS_PROCNODE
82 EXTERNAL mumps_procnode
83 include 'mumps_headers.h'
84 include 'mumps_tags.h'
85 nb_contri_global = keep(41)
86 numorg = root%ROOT_SIZE
87 nelim = keep(42)
88 nfront = numorg + keep(42)
89 DO irow = 0, root%NPROW - 1
90 DO jcol = 0, root%NPCOL - 1
91 pdest = irow * root%NPCOL + jcol
92 IF ( pdest .NE. myid ) THEN
93 CALL zmumps_buf_send_root2slave(nfront,
94 & nb_contri_global, pdest, comm, keep, ierr)
95 if (ierr.lt.0) then
96 write(6,*) ' error detected by ',
97 & 'ZMUMPS_BUF_SEND_ROOT2SLAVE'
98 CALL mumps_abort()
99 endif
100 ENDIF
101 END DO
102 END DO
103 CALL zmumps_process_root2slave( nfront,
104 & nb_contri_global, root,
105 & bufr, lbufr, lbufr_bytes, procnode_steps, posfac,
106 & iwpos, iwposcb, iptrlu,
107 & lrlu, lrlus, n, iw, liw, a, la, ptrist,
108 & ptlust_s, ptrfac,
109 & ptrast, step, pimaster, pamaster, nstk_s, comp,
110 & iflag, ierror, comm, comm_load,
111 & ipool, lpool, leaf,
112 & nbfin, myid, slavef,
113 &
114 & opassw, opeliw, itloc, rhs_mumps, fils, dad,
115 & lptrar, nelt, frtptr, frtelt,
116 & ptrarw, ptraiw,
117 & intarr,dblarr,icntl,keep,keep8,dkeep,nd )
118 IF (iflag < 0 ) RETURN
119 hf = 6 + keep(ixsz)
120 ioldps = ptlust_s(step(iroot))
121 in = iroot
122 deb_row = ioldps + hf
123 iloc_row = deb_row
124 DO WHILE (in.GT.0)
125 iw(iloc_row) = in
126 iw(iloc_row+nfront) = in
127 iloc_row = iloc_row + 1
128 in = fils(in)
129 END DO
130 ifson = -in
131 iloc_row = ioldps + hf + numorg
132 iloc_col = iloc_row + nfront
133 IF ( nelim.GT.0 ) THEN
134 in = ifson
135 DO WHILE (in.GT.0)
136 ipos_son = pimaster(step(in))
137 IF (ipos_son .EQ. 0) GOTO 100
138 nelim_son = iw(ipos_son+1+keep(ixsz))
139 if (nelim_son.eq.0) then
140 write(6,*) ' error 1 in process_last_rtnelind'
141 CALL mumps_abort()
142 endif
143 nslaves_son = iw(ipos_son+5+keep(ixsz))
144 hs = 6 + nslaves_son + keep(ixsz)
145 irow_son = ipos_son + hs
146 icol_son = irow_son + nelim_son
147 DO i = 1, nelim_son
148 iw( iloc_row+i-1 ) = iw( irow_son+i-1 )
149 ENDDO
150 DO i = 1, nelim_son
151 iw( iloc_col+i-1 ) = iw( icol_son+i-1 )
152 ENDDO
153 nelim_sent = iloc_row - ioldps - hf + 1
154 DO islave = 0,nslaves_son
155 IF (islave.EQ.0) THEN
156 pdest= mumps_procnode(procnode_steps(step(in)),keep(199))
157 ELSE
158 pdest = iw(ipos_son + 5 + islave+keep(ixsz))
159 ENDIF
160 IF (pdest.NE.myid) THEN
161 CALL zmumps_buf_send_root2son(in, nelim_sent,
162 & pdest, comm, keep, ierr )
163 if (ierr.lt.0) then
164 write(6,*) ' error detected by ',
165 & 'ZMUMPS_BUF_SEND_ROOT2SLAVE'
166 CALL mumps_abort()
167 endif
168 ELSE
169 CALL zmumps_process_root2son( comm_load, ass_irecv,
170 & in, nelim_sent, root,
171 &
172 & bufr, lbufr, lbufr_bytes, procnode_steps, posfac,
173 & iwpos, iwposcb, iptrlu,
174 & lrlu, lrlus, n, iw, liw, a, la, ptrist,
175 & ptlust_s, ptrfac,
176 & ptrast, step, pimaster, pamaster, nstk_s, comp,
177 & iflag, ierror, comm,
178 & perm,
179 & ipool, lpool, leaf,
180 & nbfin, myid, slavef,
181 &
182 & opassw, opeliw, itloc, rhs_mumps,
183 & fils, dad, ptrarw, ptraiw,
184 & intarr, dblarr, icntl, keep, keep8, dkeep, nd, frere,
185 & lptrar, nelt, frtptr, frtelt,
186 & istep_to_iniv2, tab_pos_in_pere
187 & , lrgroups
188 & )
189 IF ( islave .NE. 0 ) THEN
190 IF (keep(50) .EQ. 0) THEN
191 ipos_statrec = ptrist(step(in))+6+keep(ixsz)
192 ELSE
193 ipos_statrec = ptrist(step(in))+8+keep(ixsz)
194 ENDIF
195 IF (iw(ipos_statrec).EQ. s_rec_contstatic) THEN
196 iw(ipos_statrec) = s_root2son_called
197 ELSE
198 IF (nslaves_son .EQ. 0) THEN
199 type_son = 1
200 ELSE
201 type_son = 2
202 ENDIF
203 CALL zmumps_free_band( n, in, ptrist, ptrast,
204 & iw, liw, a, la, lrlu, lrlus, iwposcb,
205 & iptrlu, step, myid, keep, keep8, type_son
206 & )
207 ENDIF
208 ENDIF
209 ipos_son = pimaster(step(in))
210 ENDIF
211 END DO
213 & .false., myid, n, ipos_son,
214 & iw, liw,
215 & lrlu, lrlus, iptrlu,
216 & iwposcb, la, keep,keep8, .false.
217 & )
218 iloc_row = iloc_row + nelim_son
219 iloc_col = iloc_col + nelim_son
220 100 CONTINUE
221 in = frere(step(in))
222 ENDDO
223 ENDIF
224 RETURN
#define mumps_abort
Definition VE_Metis.h:25
subroutine, public zmumps_buf_send_root2son(ison, nelim_root, dest, comm, keep, ierr)
subroutine, public zmumps_buf_send_root2slave(tot_root_size, tot_cont2recv, dest, comm, keep, ierr)
int comp(int a, int b)
integer function mumps_procnode(procinfo_inode, k199)
subroutine zmumps_free_block_cb_static(ssarbr, myid, n, iposblock, iw, liw, lrlu, lrlus, iptrlu, iwposcb, la, keep, keep8, in_place_stats)
subroutine zmumps_process_root2slave(tot_root_size, tot_cont_to_recv, root, bufr, lbufr, lbufr_bytes, procnode_steps, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust, 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)
recursive subroutine zmumps_process_root2son(comm_load, ass_irecv, inode, nelim_root, 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)
subroutine zmumps_free_band(n, ison, ptrist, ptrast, iw, liw, a, la, lrlu, lrlus, iwposcb, iptrlu, step, myid, keep, keep8, type_son)
Definition ztools.F:461