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

Go to the source code of this file.

Functions/Subroutines

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)
recursive subroutine smumps_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)
recursive subroutine smumps_backslv_traiter_message (msgtag, msgsou, 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)
subroutine smumps_build_panel_pos (panel_size, panel_pos, len_panel_pos, indices, npiv, npanels, nfront_or_nass, nbentries_allpanels)

Function/Subroutine Documentation

◆ smumps_backslv_recv_and_treat()

recursive subroutine smumps_backslv_recv_and_treat ( logical bloq,
logical flag,
integer, dimension( lbufr ) bufr,
integer lbufr,
integer lbufr_bytes,
integer myid,
integer slavef,
integer comm,
integer n,
integer, dimension( liww ) iwcb,
integer liww,
integer posiwcb,
real, dimension( lwc ) w,
integer(8), intent(in) lwc,
integer(8) poswcb,
integer iipool,
integer nbfinf,
integer, dimension(keep(28)) ptricb,
integer(8), dimension(keep(28)) ptracb,
integer, dimension(80) info,
integer, dimension( lpool ) ipool,
integer lpool,
integer, dimension( lpanel_pos ) panel_pos,
integer lpanel_pos,
integer, dimension( n ) step,
integer, dimension( keep(28) ) frere,
integer, dimension( n ) fils,
integer, dimension( keep(28) ) procnode_steps,
integer(8) pleftw,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
real, dimension(230), intent(inout) dkeep,
integer, dimension(keep(28)) ptrist,
integer (8), dimension(keep(28)) ptrfac,
integer, dimension( liw ) iw,
integer liw,
real, dimension( la ) a,
integer(8) la,
real, dimension( keep(133) ) w2,
integer myleaf_left,
integer nrhs,
integer mtype,
real, dimension(lrhscomp,nrhs) rhscomp,
integer lrhscomp,
integer, dimension(n) posinrhscomp_bwd,
logical, intent(in) prun_below,
logical, dimension(size_to_process) to_process,
integer size_to_process,
logical, intent(in) from_pp )

Definition at line 961 of file ssol_bwd_aux.F.

977 IMPLICIT NONE
978 LOGICAL BLOQ, FLAG
979 INTEGER LBUFR, LBUFR_BYTES
980 INTEGER BUFR( LBUFR )
981 INTEGER MYID, SLAVEF, COMM
982 INTEGER N, LIWW
983 INTEGER IWCB( LIWW )
984 INTEGER(8), intent(in) :: LWC
985 REAL W( LWC )
986 INTEGER POSIWCB
987 INTEGER IIPOOL, LPOOL
988 INTEGER IPOOL( LPOOL )
989 INTEGER LPANEL_POS
990 INTEGER PANEL_POS( LPANEL_POS )
991 INTEGER NBFINF, INFO(80), KEEP(500)
992 INTEGER(8) :: POSWCB, PLEFTW
993 INTEGER(8) KEEP8(150)
994 REAL, INTENT(INOUT) :: DKEEP(230)
995 INTEGER PROCNODE_STEPS( KEEP(28) ), FRERE( KEEP(28) )
996 INTEGER PTRICB(KEEP(28)), STEP( N ), FILS( N )
997 INTEGER(8) :: PTRACB(KEEP(28))
998 INTEGER LIW
999 INTEGER(8) :: LA
1000 INTEGER PTRIST(KEEP(28)), IW( LIW )
1001 INTEGER (8) :: PTRFAC(KEEP(28))
1002 REAL A( LA ), W2( KEEP(133) )
1003 INTEGER NRHS
1004 INTEGER MYLEAF_LEFT, MTYPE
1005 INTEGER LRHSCOMP, POSINRHSCOMP_BWD(N)
1006 REAL RHSCOMP(LRHSCOMP,NRHS)
1007 LOGICAL, INTENT(IN) :: PRUN_BELOW
1008 INTEGER SIZE_TO_PROCESS
1009 LOGICAL TO_PROCESS(SIZE_TO_PROCESS)
1010 LOGICAL, intent(in) :: FROM_PP
1011 include 'mpif.h'
1012 include 'mumps_tags.h'
1013 INTEGER MSGSOU, MSGTAG, MSGLEN
1014 INTEGER :: STATUS(MPI_STATUS_SIZE)
1015 INTEGER :: IERR
1016 flag = .false.
1017 IF ( bloq ) THEN
1018 CALL mpi_probe( mpi_any_source, mpi_any_tag,
1019 & comm, status, ierr )
1020 flag = .true.
1021 ELSE
1022 CALL mpi_iprobe( mpi_any_source, mpi_any_tag, comm,
1023 & flag, status, ierr )
1024 END IF
1025 IF (flag) THEN
1026 keep(266)=keep(266)-1
1027 msgsou=status(mpi_source)
1028 msgtag=status(mpi_tag)
1029 CALL mpi_get_count( status, mpi_packed, msglen, ierr )
1030 IF ( msglen .GT. lbufr_bytes ) THEN
1031 info(1) = -20
1032 info(2) = msglen
1033 IF (nbfinf .NE. 0) THEN
1034 CALL smumps_bdc_error( myid, slavef, comm, keep )
1035 ENDIF
1036 ELSE
1037 CALL mpi_recv(bufr, lbufr_bytes, mpi_packed, msgsou,
1038 & msgtag, comm, status, ierr)
1039 CALL smumps_backslv_traiter_message( msgtag, msgsou,
1040 & bufr, lbufr, lbufr_bytes,
1041 & myid, slavef, comm,
1042 & n, iwcb, liww, posiwcb,
1043 & w, lwc, poswcb,
1044 & iipool, nbfinf, ptricb, ptracb, info,
1045 & ipool, lpool, panel_pos, lpanel_pos, step,
1046 & frere, fils, procnode_steps, pleftw,
1047 & keep, keep8, dkeep,
1048 & ptrist, ptrfac, iw, liw, a, la, w2, myleaf_left,
1049 & nrhs, mtype,
1050 & rhscomp, lrhscomp, posinrhscomp_bwd,
1051 & prun_below, to_process, size_to_process
1052 & , from_pp
1053 & )
1054 END IF
1055 END IF
1056 RETURN
mpi_recv
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
Definition mpi.f:461
mpi_iprobe
subroutine mpi_iprobe(source, tag, comm, flag, status, ierr)
Definition mpi.f:360
mpi_get_count
subroutine mpi_get_count(status, datatype, cnt, ierr)
Definition mpi.f:296
mpi_probe
subroutine mpi_probe(source, tag, comm, status, ierr)
Definition mpi.f:449
smumps_bdc_error
subroutine smumps_bdc_error(myid, slavef, comm, keep)
Definition sbcast_int.F:38
smumps_backslv_traiter_message
recursive subroutine smumps_backslv_traiter_message(msgtag, msgsou, 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)
Definition ssol_bwd_aux.F:1074

◆ smumps_backslv_traiter_message()

recursive subroutine smumps_backslv_traiter_message ( integer msgtag,
integer msgsou,
integer, dimension( lbufr ) bufr,
integer lbufr,
integer lbufr_bytes,
integer myid,
integer slavef,
integer comm,
integer n,
integer, dimension( liww ) iwcb,
integer liww,
integer posiwcb,
real, dimension( lwc ) w,
integer(8), intent(in) lwc,
integer(8) poswcb,
integer iipool,
integer nbfinf,
integer, dimension(keep(28)) ptricb,
integer(8), dimension(keep(28)) ptracb,
integer, dimension(80) info,
integer, dimension( lpool ) ipool,
integer lpool,
integer, dimension( lpanel_pos ) panel_pos,
integer lpanel_pos,
integer, dimension( n ) step,
integer, dimension(keep(28)) frere,
integer, dimension( n ) fils,
integer, dimension(keep(28)) procnode_steps,
integer(8) pleftw,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
real, dimension(230), intent(inout) dkeep,
integer, dimension( keep(28) ) ptrist,
integer(8), dimension(keep(28)) ptrfac,
integer, dimension( liw ) iw,
integer liw,
real, dimension( la ) a,
integer(8) la,
real, dimension( keep(133) ) w2,
integer myleaf_left,
integer nrhs,
integer mtype,
real, dimension(lrhscomp,nrhs) rhscomp,
integer lrhscomp,
integer, dimension(n) posinrhscomp_bwd,
logical, intent(in) prun_below,
logical, dimension(size_to_process) to_process,
integer size_to_process,
logical, intent(in) from_pp )

Definition at line 1058 of file ssol_bwd_aux.F.

1074 USE smumps_ooc
1075 USE smumps_sol_lr, ONLY: smumps_sol_slave_lr_u,
1076 & smumps_sol_bwd_lr_su
1077 USE smumps_buf
1078 IMPLICIT NONE
1079 INTEGER MSGTAG, MSGSOU
1080 INTEGER LBUFR, LBUFR_BYTES
1081 INTEGER BUFR( LBUFR )
1082 INTEGER MYID, SLAVEF, COMM
1083 INTEGER N, LIWW
1084 INTEGER IWCB( LIWW )
1085 INTEGER(8), intent(in) :: LWC
1086 REAL W( LWC )
1087 INTEGER POSIWCB
1088 INTEGER IIPOOL, LPOOL, LPANEL_POS
1089 INTEGER IPOOL( LPOOL )
1090 INTEGER PANEL_POS( LPANEL_POS )
1091 INTEGER NBFINF, INFO(80), KEEP(500)
1092 INTEGER(8) :: POSWCB, PLEFTW
1093 INTEGER(8) KEEP8(150)
1094 REAL, INTENT(INOUT) :: DKEEP(230)
1095 INTEGER PTRICB(KEEP(28)), STEP( N ), FILS( N )
1096 INTEGER(8) :: PTRACB(KEEP(28))
1097 INTEGER FRERE(KEEP(28))
1098 INTEGER PROCNODE_STEPS(KEEP(28))
1099 INTEGER LIW
1100 INTEGER(8) :: LA
1101 INTEGER IW( LIW ), PTRIST( KEEP(28) )
1102 INTEGER(8) :: PTRFAC(KEEP(28))
1103 REAL A( LA ), W2( KEEP(133) )
1104 INTEGER NRHS
1105 INTEGER MYLEAF_LEFT, MTYPE
1106 INTEGER LRHSCOMP, POSINRHSCOMP_BWD(N)
1107 REAL RHSCOMP(LRHSCOMP,NRHS)
1108 LOGICAL, INTENT(IN) :: PRUN_BELOW
1109 INTEGER SIZE_TO_PROCESS
1110 LOGICAL TO_PROCESS(SIZE_TO_PROCESS), NO_CHILDREN
1111 LOGICAL, intent(in) :: FROM_PP
1112 include 'mpif.h'
1113 include 'mumps_tags.h'
1114 INTEGER POSITION, IF, INODE, IERR, LONG, DUMMY(1)
1115 INTEGER :: LIELL, K
1116 INTEGER(8) :: APOS, IST
1117 INTEGER NPIV, NROW_L, IPOS, NROW_RECU
1118 INTEGER(8) :: IFR8
1119 INTEGER I, JJ, IN, PROCDEST, J1, J2, LDA
1120 INTEGER NSLAVES, NELIM, J, POSINDICES, INODEPOS,
1121 & IPOSINRHSCOMP, IPOSINRHSCOMP_PANEL
1122 INTEGER JBDEB, JBFIN, NRHS_B, allocok
1123 INTEGER(8) :: P_UPDATE, P_SOL_MAS
1124 INTEGER :: IWHDLR, MTYPE_SLAVE, LDA_SLAVE
1125 LOGICAL FLAG
1126 REAL ZERO, ALPHA, ONE
1127 parameter(zero=0.0e0, one = 1.0e0, alpha=-1.0e0)
1128 include 'mumps_headers.h'
1129 INTEGER POOL_FIRST_POS, TMP
1130 LOGICAL, DIMENSION(:), ALLOCATABLE :: DEJA_SEND
1131 INTEGER :: NCB
1132 INTEGER(8) :: APOSDEB, NBENTRIES_ALLPANELS
1133 INTEGER(8) :: PTWCB_PANEL
1134 INTEGER(8) :: PTWCB, PPIV_COURANT
1135 INTEGER LDAJ, NBJ, LIWFAC,
1136 & NBJLAST, NPIV_LAST, PANEL_SIZE,
1137 & NCB_PANEL, TYPEF
1138 LOGICAL TWOBYTWO
1139 INTEGER BEG_PANEL
1140 INTEGER IPANEL, NPANELS
1141 INTEGER TMP_NBPANELS, I_PIVRPTR, I_PIVR
1142 LOGICAL MUST_BE_PERMUTED
1143 LOGICAL COMPRESS_PANEL, LR_ACTIVATED
1144 LOGICAL OOCWRITE_COMPATIBLE_WITH_BLR
1145 LOGICAL :: ALLOW_OTHERS_TO_LEAVE
1146 LOGICAL, EXTERNAL :: MUMPS_IN_OR_ROOT_SSARBR
1147 INTEGER, EXTERNAL :: MUMPS_PROCNODE
1148 ALLOCATE(DEJA_SEND( 0:SLAVEF-1 ), stat=allocok)
1149.ne. if(allocok0) then
1150 INFO(1)=-13
1151 INFO(2)=SLAVEF
1152 WRITE(6,*) MYID,' allocation error of deja_send '
1153 & //'in bwd solve compso'
1154 GOTO 260
1155 END IF
1156 DUMMY(1)=0
1157.EQ. IF (MSGTAG TERMBWD) THEN
1158 NBFINF = NBFINF - 1
1159.EQ. ELSE IF (MSGTAG NOEUD) THEN
1160 POSITION = 0
1161 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION,
1162 & INODE, 1, MPI_INTEGER,
1163 & COMM, IERR)
1164 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1165 & JBDEB, 1, MPI_INTEGER, COMM, IERR )
1166 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1167 & JBFIN, 1, MPI_INTEGER, COMM, IERR )
1168 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION,
1169 & LONG, 1, MPI_INTEGER,
1170 & COMM, IERR)
1171 NRHS_B = JBFIN-JBDEB+1
1172.LT. IF ( POSIWCB - LONG 0
1173.OR..LT. & POSWCB - PLEFTW + 1_8 LONG ) THEN
1174 CALL SMUMPS_COMPSO(N, KEEP(28), IWCB,
1175 & LIWW, W, LWC,
1176 & POSWCB, POSIWCB, PTRICB, PTRACB)
1177.LT. IF (POSIWCB - LONG 0) THEN
1178 INFO(1)=-14
1179 INFO(2)=-POSIWCB + LONG
1180 WRITE(6,*) MYID,' internal error 1 in bwd solve compso'
1181 GOTO 260
1182 END IF
1183.LT. IF ( POSWCB - PLEFTW + 1_8 LONG ) THEN
1184 INFO(1) = -11
1185 CALL MUMPS_SET_IERROR(LONG + PLEFTW - POSWCB - 1_8,
1186 & INFO(2))
1187 WRITE(6,*) MYID,' internal error 2 in bwd solve compso'
1188 GOTO 260
1189 END IF
1190 ENDIF
1191 POSIWCB = POSIWCB - LONG
1192 POSWCB = POSWCB - LONG
1193.GT. IF (LONG 0) THEN
1194 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION,
1195 & IWCB(POSIWCB + 1),
1196 & LONG, MPI_INTEGER, COMM, IERR)
1197 DO K=JBDEB,JBFIN
1198 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION,
1199 & W(POSWCB + 1), LONG,
1200 & MPI_REAL, COMM, IERR)
1201 DO JJ=0, LONG-1
1202 IPOSINRHSCOMP = abs( POSINRHSCOMP_BWD( IWCB(
1203 & POSIWCB+1+JJ ) ) )
1204.EQ..OR. IF ( (IPOSINRHSCOMP0)
1205.GT. & ( IPOSINRHSCOMPN ) ) CYCLE
1206 RHSCOMP(IPOSINRHSCOMP,K) = W(POSWCB+1+JJ)
1207 ENDDO
1208 ENDDO
1209 POSIWCB = POSIWCB + LONG
1210 POSWCB = POSWCB + LONG
1211 ENDIF
1212 POOL_FIRST_POS = IIPOOL
1213 IF ( PRUN_BELOW ) THEN
1214.NOT. IF (TO_PROCESS(STEP(INODE)))
1215 & GOTO 1010
1216 ENDIF
1217 IPOOL( IIPOOL ) = INODE
1218 IIPOOL = IIPOOL + 1
1219 1010 CONTINUE
1220 IF = FRERE( STEP(INODE) )
1221.GT. DO WHILE ( IF 0 )
1222 IF ( MUMPS_PROCNODE(PROCNODE_STEPS(STEP(IF)),
1223.eq. & KEEP(199)) MYID ) THEN
1224 IF ( PRUN_BELOW ) THEN
1225.NOT. IF (TO_PROCESS(STEP(IF))) THEN
1226 IF = FRERE(STEP(IF))
1227 CYCLE
1228 ENDIF
1229 ENDIF
1230 IPOOL( IIPOOL ) = IF
1231 IIPOOL = IIPOOL + 1
1232 END IF
1233 IF = FRERE( STEP( IF ) )
1234 END DO
1235 DO I=1,(IIPOOL-POOL_FIRST_POS)/2
1236 TMP=IPOOL(POOL_FIRST_POS+I-1)
1237 IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I)
1238 IPOOL(IIPOOL-I)=TMP
1239 ENDDO
1240.EQ. ELSE IF ( MSGTAG BACKSLV_MASTER2SLAVE ) THEN
1241 POSITION = 0
1242 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1243 & INODE, 1, MPI_INTEGER, COMM, IERR )
1244 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1245 & NROW_RECU, 1, MPI_INTEGER, COMM, IERR )
1246 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1247 & JBDEB, 1, MPI_INTEGER, COMM, IERR )
1248 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1249 & JBFIN, 1, MPI_INTEGER, COMM, IERR )
1250 NRHS_B = JBFIN-JBDEB+1
1251.GT. LR_ACTIVATED = (IW(PTRIST(STEP(INODE))+XXLR)0)
1252.GE. COMPRESS_PANEL = (IW(PTRIST(STEP(INODE))+XXLR)2)
1253 OOCWRITE_COMPATIBLE_WITH_BLR =
1254.NOT..OR..NOT..OR. & ( LR_ACTIVATED(COMPRESS_PANEL)
1255.EQ. & (KEEP(485)0)
1256 & )
1257 IPOS = PTRIST( STEP(INODE) ) + KEEP(IXSZ)
1258 NPIV = - IW( IPOS )
1259 NROW_L = IW( IPOS + 1 )
1260.NE. IF ( NROW_L NROW_RECU ) THEN
1261 WRITE(*,*) 'error1 : nrow l/recu=',NROW_L, NROW_RECU
1262 CALL MUMPS_ABORT()
1263 END IF
1264 LONG = NROW_L + NPIV
1265.LT. IF ( POSWCB - int(LONG,8)*int(NRHS_B,8) PLEFTW - 1_8 ) THEN
1266 CALL SMUMPS_COMPSO( N, KEEP(28), IWCB,
1267 & LIWW, W, LWC,
1268 & POSWCB, POSIWCB, PTRICB, PTRACB)
1269.LT. IF ( POSWCB - LONG*NRHS_B PLEFTW - 1_8 ) THEN
1270 INFO(1) = -11
1271 CALL MUMPS_SET_IERROR(LONG * NRHS_B- POSWCB,INFO(2))
1272 WRITE(6,*) MYID,' internal error 3 in bwd solve compso'
1273 GOTO 260
1274 END IF
1275 END IF
1276 P_UPDATE = PLEFTW
1277 P_SOL_MAS = PLEFTW + int(NPIV,8) * int(NRHS_B,8)
1278 PLEFTW = P_SOL_MAS + int(NROW_L,8) * int(NRHS_B,8)
1279 DO K=JBDEB, JBFIN
1280 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1281 & W( P_SOL_MAS+(K-JBDEB)*NROW_L),NROW_L,
1282 & MPI_REAL,
1283 & COMM, IERR )
1284 ENDDO
1285.GT..AND. IF (KEEP(201)0OOCWRITE_COMPATIBLE_WITH_BLR) THEN
1286 CALL SMUMPS_SOLVE_GET_OOC_NODE(
1287 & INODE,PTRFAC,KEEP,A,LA,STEP,
1288 & KEEP8,N,MUST_BE_PERMUTED,IERR)
1289.LT. IF(IERR0)THEN
1290 INFO(1)=IERR
1291 INFO(2)=0
1292 GOTO 260
1293 ENDIF
1294 ENDIF
1295 APOS = PTRFAC( STEP(INODE))
1296.GE..AND. IF ( IW(PTRIST(STEP(INODE))+XXLR) 2
1297.EQ. & KEEP(485) 1 ) THEN
1298 IWHDLR = IW(PTRIST(STEP(INODE))+XXF)
1299 MTYPE_SLAVE = 0
1300 W(P_UPDATE:P_UPDATE+NPIV*NRHS_B-1)=ZERO
1301 CALL SMUMPS_SOL_SLAVE_LR_U(INODE, IWHDLR, -9999,
1302 & W, LWC,
1303 & NROW_L, NPIV,
1304 & P_SOL_MAS, P_UPDATE,
1305 & JBDEB, JBFIN,
1306 & MTYPE_SLAVE, KEEP, KEEP8,
1307 & INFO(1), INFO(2) )
1308 ELSE
1309.EQ..AND. IF (KEEP(201) 1OOCWRITE_COMPATIBLE_WITH_BLR)
1310 & THEN
1311 MTYPE_SLAVE = 1
1312 LDA_SLAVE = NROW_L
1313 ELSE
1314 MTYPE_SLAVE = 0
1315 LDA_SLAVE = NPIV
1316 ENDIF
1317 CALL SMUMPS_SOLVE_GEMM_UPDATE(
1318 & A, LA, APOS, NROW_L,
1319 & LDA_SLAVE,
1320 & NPIV,
1321 & NRHS_B, W, LWC,
1322 & P_SOL_MAS, NROW_L,
1323 & P_UPDATE, NPIV,
1324 & MTYPE_SLAVE, KEEP, ZERO)
1325 ENDIF
1326.EQ..AND. IF (KEEP(201) 1OOCWRITE_COMPATIBLE_WITH_BLR)
1327 & THEN
1328 CALL SMUMPS_FREE_FACTORS_FOR_SOLVE(INODE,PTRFAC,KEEP(28),
1329 & A,LA,.TRUE.,IERR)
1330.LT. IF(IERR0)THEN
1331 INFO(1)=IERR
1332 INFO(2)=0
1333 GOTO 260
1334 ENDIF
1335 ENDIF
1336 PLEFTW = PLEFTW - int(NROW_L,8) * int(NRHS_B,8)
1337 100 CONTINUE
1338 CALL SMUMPS_BUF_SEND_BACKVEC( NRHS_B, INODE,
1339 & W(P_UPDATE),
1340 & NPIV, NPIV,
1341 & MSGSOU,
1342 & BACKSLV_UPDATERHS,
1343 & JBDEB, JBFIN,
1344 & KEEP, COMM, IERR )
1345.EQ. IF ( IERR -1 ) THEN
1346 CALL SMUMPS_BACKSLV_RECV_AND_TREAT(
1347 & .FALSE., FLAG,
1348 & BUFR, LBUFR, LBUFR_BYTES,
1349 & MYID, SLAVEF, COMM,
1350 & N, IWCB, LIWW, POSIWCB,
1351 & W, LWC, POSWCB,
1352 & IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
1353 & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP,
1354 & FRERE, FILS, PROCNODE_STEPS, PLEFTW,
1355 & KEEP, KEEP8, DKEEP,
1356 & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAF_LEFT,
1357 & NRHS, MTYPE,
1358 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_BWD,
1359 & PRUN_BELOW, TO_PROCESS, SIZE_TO_PROCESS
1360 & , FROM_PP
1361 & )
1362.LT. IF ( INFO( 1 ) 0 ) GOTO 270
1363 GOTO 100
1364.EQ. ELSE IF ( IERR -2 ) THEN
1365 INFO( 1 ) = -17
1366 INFO( 2 ) = NRHS_B * NPIV * KEEP(35) + 4 * KEEP(34)
1367 GOTO 260
1368.EQ. ELSE IF ( IERR -3 ) THEN
1369 INFO( 1 ) = -20
1370 INFO( 2 ) = NRHS_B * NPIV * KEEP(35) + 4 * KEEP(34)
1371 GOTO 260
1372 END IF
1373 PLEFTW = PLEFTW - NPIV * NRHS_B
1374.EQ. ELSE IF ( MSGTAG BACKSLV_UPDATERHS ) THEN
1375 POSITION = 0
1376 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1377 & INODE, 1, MPI_INTEGER, COMM, IERR )
1378.GT. LR_ACTIVATED = (IW(PTRIST(STEP(INODE))+XXLR)0)
1379.GE. COMPRESS_PANEL = (IW(PTRIST(STEP(INODE))+XXLR)2)
1380 OOCWRITE_COMPATIBLE_WITH_BLR =
1381.NOT..OR..NOT..OR. & (LR_ACTIVATED(COMPRESS_PANEL)
1382.EQ. & (KEEP(485)0)
1383 & )
1384 IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ)
1385 LIELL = IW(IPOS-2)+IW(IPOS+1)
1386 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1387 & NPIV, 1, MPI_INTEGER, COMM, IERR )
1388 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1389 & JBDEB, 1, MPI_INTEGER, COMM, IERR )
1390 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1391 & JBFIN, 1, MPI_INTEGER, COMM, IERR )
1392 NRHS_B = JBFIN-JBDEB+1
1393 NELIM = IW(IPOS-1)
1394 IPOS = IPOS + 1
1395 NPIV = IW(IPOS)
1396 IPOS = IPOS + 1
1397 NSLAVES = IW( IPOS + 1 )
1398 IPOS = IPOS + 1 + NSLAVES
1399 INODEPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 4
1400.eq. IF ( KEEP(50) 0 ) THEN
1401 LDA = LIELL
1402 ELSE
1403 LDA = NPIV
1404 ENDIF
1405.EQ..AND..EQ. IF ( MTYPE 1 KEEP(50)0 ) THEN
1406 J1 = IPOS + LIELL + 1
1407 J2 = IPOS + NPIV + LIELL
1408 ELSE
1409 J1 = IPOS + 1
1410 J2 = IPOS + NPIV
1411 ENDIF
1412 IPOSINRHSCOMP = POSINRHSCOMP_BWD(IW(J1))
1413 DO K=JBDEB, JBFIN
1414 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1415 & W2, NPIV, MPI_REAL,
1416 & COMM, IERR )
1417 I = 1
1418.NE..AND. IF ( (KEEP(253)0)
1419.EQ. & (IW(PTRIST(STEP(INODE))+XXS)C_FINI+NSLAVES)
1420 & ) THEN
1421 DO JJ = J1,J2
1422 RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) = W2(I)
1423 I = I+1
1424 ENDDO
1425 ELSE
1426 DO JJ = J1,J2
1427 RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) =
1428 & RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) + W2(I)
1429 I = I+1
1430 ENDDO
1431 ENDIF
1432 ENDDO
1433 IW(PTRIST(STEP(INODE))+XXS) =
1434 & IW(PTRIST(STEP(INODE))+XXS) - 1
1435.EQ. IF ( IW(PTRIST(STEP(INODE))+XXS)C_FINI ) THEN
1436.GT..AND. IF (KEEP(201)0OOCWRITE_COMPATIBLE_WITH_BLR)
1437 & THEN
1438 CALL SMUMPS_SOLVE_GET_OOC_NODE(
1439 & INODE,PTRFAC,KEEP,A,LA,STEP,
1440 & KEEP8,N,MUST_BE_PERMUTED,IERR)
1441.LT. IF(IERR0)THEN
1442 INFO(1)=IERR
1443 INFO(2)=0
1444 GOTO 260
1445 ENDIF
1446.EQ..AND..NE. IF (KEEP(201)1 KEEP(50)1) THEN
1447 CALL SMUMPS_OOC_PP_CHECK_PERM_FREED(
1448 & IW(IPOS+1+2*LIELL),
1449 & MUST_BE_PERMUTED )
1450 ENDIF
1451 ENDIF
1452 APOS = PTRFAC(IW(INODEPOS))
1453.EQ..AND. IF (KEEP(201)1OOCWRITE_COMPATIBLE_WITH_BLR)
1454 & THEN
1455 LIWFAC = IW(PTRIST(STEP(INODE))+XXI)
1456 TYPEF = TYPEF_L
1457 NROW_L = NPIV+NELIM
1458 PANEL_SIZE = SMUMPS_OOC_PANEL_SIZE(NROW_L)
1459.LT. IF (PANEL_SIZE0) THEN
1460 WRITE(6,*) ' internal error in bwd solve panel_size=',
1461 & PANEL_SIZE
1462 CALL MUMPS_ABORT()
1463 ENDIF
1464 ENDIF
1465.LT..or. IF ( POSIWCB - 2 0
1466.LT. & POSWCB-int(LIELL,8)*int(NRHS_B,8) PLEFTW-1_8 ) THEN
1467 CALL SMUMPS_COMPSO( N, KEEP(28), IWCB, LIWW, W, LWC,
1468 & POSWCB, POSIWCB, PTRICB, PTRACB )
1469.LT. IF ( POSWCB-int(LIELL,8)*int(NRHS_B,8) PLEFTW-1_8 ) THEN
1470 INFO( 1 ) = -11
1471 CALL MUMPS_SET_IERROR( int(LIELL,8)*int(NRHS_B,8)-
1472 & POSWCB-PLEFTW+1_8,
1473 & INFO(2) )
1474 GOTO 260
1475 END IF
1476.LT. IF ( POSIWCB - 2 0 ) THEN
1477 INFO( 1 ) = -14
1478 INFO( 2 ) = 2 - POSIWCB
1479 GO TO 260
1480 END IF
1481 END IF
1482 POSIWCB = POSIWCB - 2
1483 POSWCB = POSWCB - int(LIELL,8)*int(NRHS_B,8)
1484 PTRICB(STEP( INODE )) = POSIWCB + 1
1485 PTRACB(STEP( INODE )) = POSWCB + 1_8
1486 IWCB( PTRICB(STEP( INODE )) ) = LIELL*NRHS_B
1487 IWCB( PTRICB(STEP( INODE )) + 1 ) = 1
1488 IPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 5 + NSLAVES
1489.EQ..AND..EQ. IF ( MTYPE1 KEEP(50)0 ) THEN
1490 POSINDICES = IPOS + LIELL + 1
1491 ELSE
1492 POSINDICES = IPOS + 1
1493 END IF
1494 PTWCB = PTRACB(STEP( INODE ))
1495 IPOSINRHSCOMP = POSINRHSCOMP_BWD(IW(J1))
1496 IFR8 = PTRACB(STEP( INODE ))
1497 IFR8 = PTWCB + int(NPIV - 1,8)
1498.EQ..AND..EQ. IF ( MTYPE 1 KEEP(50)0 ) THEN
1499 J1 = IPOS + LIELL + NPIV + 1
1500 J2 = IPOS + 2 * LIELL
1501 ELSE
1502 J1 = IPOS + NPIV + 1
1503 J2 = IPOS + LIELL
1504 END IF
1505 CALL SMUMPS_SOL_BWD_GTHR( JBDEB, JBFIN, J1, J2,
1506 & RHSCOMP, NRHS, LRHSCOMP,
1507 & W(PTWCB), LIELL, NPIV+1,
1508 & IW, LIW, KEEP, N, POSINRHSCOMP_BWD )
1509 IFR8 = IFR8 + int(J2-KEEP(253)-J1+1,8)
1510.EQ..AND..AND. IF ( KEEP(201)1 OOCWRITE_COMPATIBLE_WITH_BLR
1511.GT..OR..NE. & (( NELIM 0 ) (MTYPE1 ))) THEN
1512 J = NPIV / PANEL_SIZE
1513.EQ..AND..GT. TWOBYTWO = KEEP(50)2 KEEP(105)0
1514 IF (TWOBYTWO) THEN
1515 CALL SMUMPS_BUILD_PANEL_POS(PANEL_SIZE, PANEL_POS, LPANEL_POS,
1516 & IW(IPOS+1+LIELL), NPIV, NPANELS, NROW_L,
1517 & NBENTRIES_ALLPANELS)
1518 ELSE
1519.EQ. IF (NPIVJ*PANEL_SIZE) THEN
1520 NPIV_LAST = NPIV
1521 NBJLAST = PANEL_SIZE
1522 NPANELS = J
1523 ELSE
1524 NPIV_LAST = (J+1)* PANEL_SIZE
1525 NBJLAST = NPIV-J*PANEL_SIZE
1526 NPANELS = J+1
1527 ENDIF
1528 NBENTRIES_ALLPANELS =
1529 & int(NROW_L,8) * int(NPIV,8)
1530 & - int( ( J * ( J - 1 ) ) /2,8 )
1531 & * int(PANEL_SIZE,8) * int(PANEL_SIZE,8)
1532 & - int(J,8)
1533 & * int(mod(NPIV, PANEL_SIZE),8)
1534 & * int(PANEL_SIZE,8)
1535 JJ=NPIV_LAST
1536 ENDIF
1537 APOSDEB = APOS + NBENTRIES_ALLPANELS
1538 DO IPANEL = NPANELS, 1, -1
1539 IF (TWOBYTWO) THEN
1540 NBJ = PANEL_POS(IPANEL+1)-PANEL_POS(IPANEL)
1541 BEG_PANEL = PANEL_POS(IPANEL)
1542 ELSE
1543.EQ. IF (JJNPIV_LAST) THEN
1544 NBJ = NBJLAST
1545 ELSE
1546 NBJ = PANEL_SIZE
1547 ENDIF
1548 BEG_PANEL = JJ- PANEL_SIZE+1
1549 ENDIF
1550 LDAJ = NROW_L-BEG_PANEL+1
1551 APOSDEB = APOSDEB - int(NBJ,8)*int(LDAJ,8)
1552 PTWCB = PTRACB(STEP(INODE))
1553 PTWCB_PANEL = PTRACB(STEP(INODE)) + int(BEG_PANEL - 1,8)
1554 IPOSINRHSCOMP_PANEL = IPOSINRHSCOMP + BEG_PANEL - 1
1555 NCB_PANEL = LDAJ - NBJ
1556 NCB = NROW_L - NPIV
1557.NE..AND. IF (KEEP(50)1 MUST_BE_PERMUTED) THEN
1558 CALL SMUMPS_GET_OOC_PERM_PTR(TYPEF, TMP_NBPANELS,
1559 & I_PIVRPTR, I_PIVR, IPOS + 1 + 2 * LIELL, IW, LIW)
1560 CALL SMUMPS_PERMUTE_PANEL(
1561 & IW(I_PIVR + IW(I_PIVRPTR+IPANEL-1)-IW(I_PIVRPTR)),
1562 & NPIV-IW(I_PIVRPTR+IPANEL-1)+1,
1563 & IW(I_PIVRPTR+IPANEL-1)-1,
1564 & A(APOSDEB),
1565 & LDAJ, NBJ, BEG_PANEL-1)
1566 ENDIF
1567#if defined(MUMPS_USE_BLAS2)
1568 IF ( NRHS_B == 1 ) THEN
1569.NE. IF (NCB_PANEL0) THEN
1570.NE. IF (NCB_PANEL - NCB 0) THEN
1571 CALL sgemv( 't', NCB_PANEL-NCB, NBJ, ALPHA,
1572 & A( APOSDEB + int(NBJ,8) ), LDAJ,
1573 & RHSCOMP(IPOSINRHSCOMP_PANEL+NBJ,JBDEB),
1574 & 1, ONE,
1575 & RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB), 1 )
1576 ENDIF
1577.NE. IF (NCB 0) THEN
1578 CALL sgemv( 't', NCB, NBJ, ALPHA,
1579 & A( APOSDEB + int(LDAJ-NCB,8) ), LDAJ,
1580 & W( PTWCB + int(NPIV,8) ),
1581 & 1, ONE,
1582 & RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB), 1 )
1583 ENDIF
1584 ENDIF
1585.NE. IF (MTYPE1) THEN
1586 CALL strsv('l','t','u', NBJ, A(APOSDEB), LDAJ,
1587 & RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB), 1)
1588 ELSE
1589 CALL strsv('l','t','n', NBJ, A(APOSDEB), LDAJ,
1590 & RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB), 1)
1591 ENDIF
1592 ELSE
1593#endif
1594.NE. IF (NCB_PANEL0) THEN
1595.NE. IF (NCB_PANEL - NCB 0) THEN
1596 CALL sgemm( 't', 'n', NBJ, NRHS_B,
1597 & NCB_PANEL-NCB, ALPHA,
1598 & A(APOSDEB +int(NBJ,8)), LDAJ,
1599 & RHSCOMP(IPOSINRHSCOMP_PANEL+NBJ,JBDEB), LRHSCOMP,
1600 & ONE, RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB), LRHSCOMP)
1601 ENDIF
1602.NE. IF (NCB 0) THEN
1603 CALL sgemm( 't', 'n', NBJ, NRHS_B, NCB, ALPHA,
1604 & A(APOSDEB +int(LDAJ-NCB,8)), LDAJ,
1605 & W( PTWCB+int(NPIV,8) ), LIELL,
1606 & ONE, RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB),LRHSCOMP)
1607 ENDIF
1608 ENDIF
1609.NE. IF (MTYPE1) THEN
1610 CALL strsm('l','l','t','u',NBJ, NRHS_B, ONE,
1611 & A(APOSDEB),
1612 & LDAJ, RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB), LRHSCOMP)
1613 ELSE
1614 CALL strsm('l','l','t','n',NBJ, NRHS_B, ONE,
1615 & A(APOSDEB),
1616 & LDAJ, RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB), LRHSCOMP)
1617 ENDIF
1618#if defined(MUMPS_USE_BLAS2)
1619 ENDIF
1620#endif
1621.NOT. IF ( TWOBYTWO) JJ=BEG_PANEL-1
1622 ENDDO
1623 GOTO 1234
1624 ENDIF
1625.GE. IF ( IW(PTRIST(STEP(INODE))+XXLR) 2
1626.AND..EQ. & KEEP(485) 1 ) THEN
1627 IWHDLR = IW(PTRIST(STEP(INODE))+XXF)
1628 CALL SMUMPS_SOL_BWD_LR_SU (
1629 & INODE, IWHDLR, NPIV, NSLAVES,
1630 & LIELL, W, LWC, NRHS_B, PTRACB(STEP(INODE)),
1631 & RHSCOMP, LRHSCOMP, NRHS,
1632 & IPOSINRHSCOMP, JBDEB,
1633 & MTYPE, KEEP, KEEP8,
1634 & INFO(1), INFO(2) )
1635 ELSE
1636.GT. IF (NELIM 0) THEN
1637.eq. IF ( KEEP(50) 0 ) THEN
1638 IST = APOS + int(NPIV,8) * int(LIELL,8)
1639 ELSE
1640.GT. IF( KEEP(459) 1) THEN
1641 CALL MUMPS_GETI8(IST, IW(PTRIST(STEP(INODE))+XXR))
1642 IST = APOS + IST - int(NPIV,8) * int(NELIM,8)
1643 ELSE
1644 IST = APOS + int(NPIV,8) * int(NPIV,8)
1645 ENDIF
1646 END IF
1647#if defined(MUMPS_USE_BLAS2)
1648 IF ( NRHS_B == 1 ) THEN
1649 CALL sgemv( 'n', NPIV, NELIM, ALPHA, A( IST ), NPIV,
1650 & W( NPIV + PTRACB(STEP(INODE)) ),
1651 & 1, ONE,
1652 & RHSCOMP(IPOSINRHSCOMP,JBDEB), 1 )
1653 ELSE
1654#endif
1655 CALL sgemm( 'n', 'n', NPIV, NRHS_B, NELIM, ALPHA,
1656 & A(IST), NPIV, W(NPIV+PTRACB(STEP(INODE))), LIELL,
1657 & ONE, RHSCOMP(IPOSINRHSCOMP,JBDEB), LRHSCOMP)
1658#if defined(MUMPS_USE_BLAS2)
1659 END IF
1660#endif
1661 ENDIF
1662 PPIV_COURANT = int(JBDEB-1,8)*int(LRHSCOMP,8)
1663 & + int(IPOSINRHSCOMP,8)
1664.GT..AND..NE. IF (KEEP(459)1 KEEP(50)0) THEN
1665 CALL SMUMPS_SOLVE_BWD_PANELS( A, LA, APOS,
1666 & NPIV, IW(IPOS+1+LIELL),
1667 & NRHS_B, RHSCOMP(1,1), KEEP8(25), LRHSCOMP, PPIV_COURANT,
1668 & MTYPE, KEEP )
1669 ELSE
1670 CALL SMUMPS_SOLVE_BWD_TRSOLVE( A, LA, APOS,
1671 & NPIV, LDA,
1672 & NRHS_B, RHSCOMP(1,1), KEEP8(25), LRHSCOMP, PPIV_COURANT,
1673 & MTYPE, KEEP )
1674 ENDIF
1675 ENDIF
1676 1234 CONTINUE
1677.GT..AND. IF (KEEP(201)0OOCWRITE_COMPATIBLE_WITH_BLR) THEN
1678 CALL SMUMPS_FREE_FACTORS_FOR_SOLVE(INODE,PTRFAC,KEEP(28),
1679 & A,LA,.TRUE.,IERR)
1680.LT. IF(IERR0)THEN
1681 INFO(1)=IERR
1682 INFO(2)=0
1683 GOTO 260
1684 ENDIF
1685 ENDIF
1686 IPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 6 + NSLAVES
1687 IPOSINRHSCOMP = POSINRHSCOMP_BWD(IW(IPOS))
1688 IN = INODE
1689 170 IN = FILS(IN)
1690.GT. IF (IN 0) GOTO 170
1691.EQ. IF (IN 0) THEN
1692 MYLEAF_LEFT = MYLEAF_LEFT - 1
1693.EQ..AND. ALLOW_OTHERS_TO_LEAVE = ( MYLEAF_LEFT 0
1694.EQ. & KEEP(31) 0 )
1695.NE. IF (KEEP(31) 0) THEN
1696.NOT. IF ( MUMPS_IN_OR_ROOT_SSARBR(
1697 & PROCNODE_STEPS(STEP(INODE)),
1698 & KEEP(199) ) ) THEN
1699 KEEP(31) = KEEP(31) - 1
1700.EQ. IF (KEEP(31) 1) THEN
1701 ALLOW_OTHERS_TO_LEAVE = .TRUE.
1702 ENDIF
1703 ENDIF
1704 ENDIF
1705 IF ( ALLOW_OTHERS_TO_LEAVE ) THEN
1706 CALL SMUMPS_MCAST2( DUMMY, 1, MPI_INTEGER, MYID, COMM,
1707 & TERMBWD, SLAVEF, KEEP )
1708 NBFINF = NBFINF - 1
1709 ENDIF
1710 IWCB( PTRICB(STEP(INODE)) + 1 ) = 0
1711 CALL SMUMPS_FREETOPSO(N, KEEP(28),
1712 & IWCB, LIWW, W, LWC,
1713 & POSWCB, POSIWCB, PTRICB, PTRACB)
1714 GOTO 270
1715 ENDIF
1716 DO I = 0, SLAVEF - 1
1717 DEJA_SEND( I ) = .FALSE.
1718 END DO
1719 IN = -IN
1720 IF ( PRUN_BELOW ) THEN
1721 NO_CHILDREN = .TRUE.
1722 ELSE
1723 NO_CHILDREN = .FALSE.
1724 ENDIF
1725.GT. DO WHILE (IN0)
1726 IF ( PRUN_BELOW ) THEN
1727.NOT. IF ( TO_PROCESS(STEP(IN)) ) THEN
1728 IN = FRERE(STEP(IN))
1729 CYCLE
1730 ELSE
1731 NO_CHILDREN = .FALSE.
1732 ENDIF
1733 ENDIF
1734 POOL_FIRST_POS = IIPOOL
1735 IF (MUMPS_PROCNODE(PROCNODE_STEPS(STEP(IN)),
1736.EQ. & KEEP(199)) MYID) THEN
1737 IPOOL(IIPOOL ) = IN
1738 IIPOOL = IIPOOL + 1
1739 ELSE
1740 PROCDEST = MUMPS_PROCNODE( PROCNODE_STEPS(STEP(IN)),
1741 & KEEP(199) )
1742.NOT. IF ( DEJA_SEND( PROCDEST ) ) THEN
1743 400 CONTINUE
1744 CALL SMUMPS_BUF_SEND_VCB( NRHS_B, IN, 0, 0,
1745 & LIELL, LIELL - KEEP(253),
1746 & IW( POSINDICES ),
1747 & W( PTRACB(STEP(INODE)) ), JBDEB, JBFIN,
1748 & RHSCOMP(1, 1), NRHS, LRHSCOMP,
1749 & IPOSINRHSCOMP, NPIV,
1750 & KEEP, PROCDEST, NOEUD, COMM, IERR )
1751.EQ. IF ( IERR -1 ) THEN
1752 CALL SMUMPS_BACKSLV_RECV_AND_TREAT(
1753 & .FALSE., FLAG,
1754 & BUFR, LBUFR, LBUFR_BYTES,
1755 & MYID, SLAVEF, COMM,
1756 & N, IWCB, LIWW, POSIWCB,
1757 & W, LWC, POSWCB,
1758 & IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
1759 & IPOOL, LPOOL, PANEL_POS, LPANEL_POS,
1760 & STEP, FRERE, FILS, PROCNODE_STEPS,
1761 & PLEFTW, KEEP, KEEP8, DKEEP,
1762 & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAF_LEFT,
1763 & NRHS, MTYPE,
1764 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_BWD,
1765 & PRUN_BELOW, TO_PROCESS, SIZE_TO_PROCESS
1766 & , FROM_PP
1767 & )
1768.LT. IF ( INFO( 1 ) 0 ) THEN
1769 GOTO 270
1770 ENDIF
1771 GOTO 400
1772.EQ. ELSE IF ( IERR -2 ) THEN
1773 INFO( 1 ) = -17
1774 INFO( 2 ) = NRHS_B * LIELL * KEEP(35) + 4 * KEEP(34)
1775 GOTO 260
1776.EQ. ELSE IF ( IERR -3 ) THEN
1777 INFO( 1 ) = -20
1778 INFO( 2 ) = NRHS_B * LIELL * KEEP(35) + 4 * KEEP(34)
1779 GOTO 260
1780 END IF
1781 DEJA_SEND( PROCDEST ) = .TRUE.
1782 END IF
1783 END IF
1784 IN = FRERE( STEP( IN ) )
1785 END DO
1786 ALLOW_OTHERS_TO_LEAVE = .FALSE.
1787 IF (NO_CHILDREN) THEN
1788 MYLEAF_LEFT = MYLEAF_LEFT - 1
1789.EQ..AND. ALLOW_OTHERS_TO_LEAVE = ( MYLEAF_LEFT 0
1790.EQ. & KEEP(31) 0 )
1791 ENDIF
1792.NE. IF (KEEP(31) 0) THEN
1793.NOT. IF ( MUMPS_IN_OR_ROOT_SSARBR(
1794 & PROCNODE_STEPS(STEP(INODE)),
1795 & KEEP(199) ) ) THEN
1796 KEEP(31) = KEEP(31) - 1
1797.EQ. IF (KEEP(31) 1) THEN
1798 ALLOW_OTHERS_TO_LEAVE = .TRUE.
1799 ENDIF
1800 ENDIF
1801 ENDIF
1802 IF ( ALLOW_OTHERS_TO_LEAVE ) THEN
1803 CALL SMUMPS_MCAST2( DUMMY, 1, MPI_INTEGER, MYID,
1804 & COMM, TERMBWD, SLAVEF, KEEP )
1805 NBFINF = NBFINF - 1
1806 ENDIF
1807.NOT. IF ( NO_CHILDREN ) THEN
1808 DO I=1,(IIPOOL-POOL_FIRST_POS)/2
1809 TMP=IPOOL(POOL_FIRST_POS+I-1)
1810 IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I)
1811 IPOOL(IIPOOL-I)=TMP
1812 ENDDO
1813 ENDIF
1814 IWCB( PTRICB(STEP( INODE )) + 1 ) = 0
1815 CALL SMUMPS_FREETOPSO( N, KEEP(28),
1816 & IWCB, LIWW, W, LWC,
1817 & POSWCB, POSIWCB, PTRICB, PTRACB)
1818 END IF
1819.EQ. ELSE IF (MSGTAGTERREUR) THEN
1820 INFO(1) = -001
1821 INFO(2) = MSGSOU
1822 GO TO 270
1823.EQ..OR. ELSE IF ( (MSGTAGUPDATE_LOAD)
1824.EQ. & (MSGTAGTAG_DUMMY) ) THEN
1825 GO TO 270
1826 ELSE
1827 INFO(1) = -100
1828 INFO(2) = MSGTAG
1829 GOTO 260
1830 ENDIF
1831 GO TO 270
1832 260 CONTINUE
1833.NE. IF (NBFINF 0) THEN
1834 CALL SMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
1835 ENDIF
1836 270 CONTINUE
1837 IF (allocated(DEJA_SEND)) DEALLOCATE(DEJA_SEND)
1838 RETURN
alpha
#define alpha
Definition eval.h:35
smumps_buf
Definition smumps_comm_buffer.F:14
smumps_ooc
Definition smumps_ooc.F:14
smumps_sol_lr
Definition ssol_lr.F:14
smumps_sol_lr::smumps_sol_bwd_lr_su
subroutine smumps_sol_bwd_lr_su(inode, iwhdlr, npiv_global, nslaves, liell, wcb, lwcb, nrhs_b, ptwcb, rhscomp, lrhscomp, nrhs, iposinrhscomp, jbdeb, mtype, keep, keep8, iflag, ierror)
Definition ssol_lr.F:386
smumps_sol_lr::smumps_sol_slave_lr_u
subroutine smumps_sol_slave_lr_u(inode, iwhdlr, npiv_global, wcb, lwcb, ldx, ldy, ptrx_init, ptry_init, jbdeb, jbfin, mtype, keep, keep8, iflag, ierror)
Definition ssol_lr.F:189

◆ smumps_build_panel_pos()

subroutine smumps_build_panel_pos ( integer, intent(in) panel_size,
integer, dimension(len_panel_pos), intent(out) panel_pos,
integer, intent(in) len_panel_pos,
integer, dimension(npiv), intent(in) indices,
integer, intent(in) npiv,
integer, intent(out) npanels,
integer, intent(in) nfront_or_nass,
integer(8), intent(out) nbentries_allpanels )

Definition at line 1840 of file ssol_bwd_aux.F.

1844 IMPLICIT NONE
1845 INTEGER, intent (in) :: PANEL_SIZE, NPIV
1846 INTEGER, intent (in) :: INDICES(NPIV)
1847 INTEGER, intent (in) :: LEN_PANEL_POS
1848 INTEGER, intent (out) :: NPANELS
1849 INTEGER, intent (out) :: PANEL_POS(LEN_PANEL_POS)
1850 INTEGER, intent (in) :: NFRONT_OR_NASS
1851 INTEGER(8), intent(out):: NBENTRIES_ALLPANELS
1852 INTEGER NPANELS_MAX, I, NBeff
1853 INTEGER(8) :: NBENTRIES_THISPANEL
1854 nbentries_allpanels = 0_8
1855 npanels_max = (npiv+panel_size-1)/panel_size
1856 IF (len_panel_pos .LT. npanels_max + 1) THEN
1857 WRITE(*,*) "Error 1 in SMUMPS_BUILD_PANEL_POS",
1858 & len_panel_pos,npanels_max
1859 CALL mumps_abort()
1860 ENDIF
1861 i = 1
1862 npanels = 0
1863 IF (i .GT. npiv) RETURN
1864 10 CONTINUE
1865 npanels = npanels + 1
1866 panel_pos(npanels) = i
1867 nbeff = min(panel_size, npiv-i+1)
1868 IF ( indices(i+nbeff-1) < 0) THEN
1869 nbeff=nbeff+1
1870 ENDIF
1871 nbentries_thispanel = int(nfront_or_nass-i+1,8) * int(nbeff,8)
1872 nbentries_allpanels = nbentries_allpanels + nbentries_thispanel
1873 i=i+nbeff
1874 IF ( i .LE. npiv ) GOTO 10
1875 panel_pos(npanels+1)=npiv+1
1876 RETURN
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
min
#define min(a, b)
Definition macros.h:20

◆ smumps_solve_node_bwd()

subroutine smumps_solve_node_bwd ( integer, intent(in) inode,
integer, intent(in) n,
integer, dimension(lpool), intent(inout) ipool,
integer, intent(in) lpool,
integer, intent(inout) iipool,
integer, intent(inout) nbfinf,
real, dimension( la ) a,
integer(8), intent(in) la,
integer, dimension(liw) iw,
integer, intent(in) liw,
real, dimension(lwc) w,
integer(8), intent(in) lwc,
integer, intent(in) nrhs,
integer(8), intent(inout) poswcb,
integer(8), intent(inout) pleftw,
integer, intent(inout) posiwcb,
real, 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,
real, dimension(keep(133)) w2,
integer, dimension(keep(28)), intent(in) ne_steps,
integer, dimension(n) step,
integer, dimension(keep(28)) frere,
integer, dimension(n) fils,
integer, dimension(keep(28)) ptrist,
integer(8), dimension(keep(28)) ptrfac,
integer, intent(inout) myleaf_left,
integer, dimension(80) info,
integer, dimension(keep(28)), intent(in) procnode_steps,
logical, dimension(0:slavef-1), intent(inout) deja_send,
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,
real, dimension( lrhs_root ) rhs_root,
integer(8), intent(in) lrhs_root,
integer, intent(in) 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, intent(in) 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,
logical, intent(out) error_was_broadcasted,
logical, intent(out) do_mcast2_termbwd )

Definition at line 14 of file ssol_bwd_aux.F.

32 USE smumps_ooc
33 USE smumps_buf
34 USE smumps_sol_lr, only : smumps_sol_bwd_lr_su
35 IMPLICIT NONE
36 INTEGER :: KEEP( 500 )
37 INTEGER(8) :: KEEP8(150)
38 REAL, INTENT(INOUT) :: DKEEP(230)
39 INTEGER :: INFO(80)
40 INTEGER, INTENT( IN ) :: INODE, N, NRHS, MTYPE, LIW, LIWW
41 INTEGER, INTENT( IN ) :: SLAVEF, COMM, MYID
42 INTEGER, INTENT (IN ) :: PROCNODE_STEPS(KEEP(28))
43 INTEGER, INTENT( IN ) :: NE_STEPS(KEEP(28))
44 INTEGER(8), INTENT( IN ) :: LA, LWC
45 INTEGER(8), INTENT( INOUT ) :: POSWCB, PLEFTW
46 INTEGER, INTENT( INOUT ) :: POSIWCB
47 INTEGER, INTENT( IN ) :: LPANEL_POS
48 INTEGER :: PANEL_POS(LPANEL_POS)
49 LOGICAL, INTENT(INOUT) :: DEJA_SEND(0:SLAVEF-1)
50 INTEGER, INTENT(IN) :: LPOOL
51 INTEGER, INTENT(INOUT) :: IPOOL(LPOOL), IIPOOL
52 INTEGER, INTENT(INOUT) :: NBFINF, MYLEAF_LEFT
53 INTEGER :: PTRIST(KEEP(28)), PTRICB(KEEP(28))
54 INTEGER(8) :: PTRACB(KEEP(28))
55 INTEGER(8) :: PTRFAC(KEEP(28))
56 REAL :: A( LA )
57 REAL :: W(LWC)
58 REAL :: W2(KEEP(133))
59 INTEGER :: IW(LIW),IWCB(LIWW)
60 INTEGER STEP(N), FRERE(KEEP(28)),FILS(N)
61 INTEGER LBUFR, LBUFR_BYTES
62 INTEGER BUFR(LBUFR)
63 INTEGER ISTEP_TO_INIV2(KEEP(71)),
64 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
65 INTEGER LRHSCOMP, POSINRHSCOMP_BWD(N)
66 REAL RHSCOMP(LRHSCOMP,NRHS)
67 INTEGER(8), intent(in) :: LRHS_ROOT
68 REAL RHS_ROOT( LRHS_ROOT )
69 LOGICAL, INTENT( IN ) :: PRUN_BELOW
70 INTEGER, INTENT(IN) :: SIZE_TO_PROCESS
71 LOGICAL, INTENT(IN) :: TO_PROCESS(SIZE_TO_PROCESS)
72 LOGICAL, INTENT(IN) :: DO_NBSPARSE
73 INTEGER, INTENT(IN) :: LRHS_BOUNDS
74 INTEGER, INTENT(IN) :: RHS_BOUNDS(LRHS_BOUNDS)
75 LOGICAL, INTENT(IN) :: FROM_PP
76 LOGICAL, INTENT( OUT ) :: ERROR_WAS_BROADCASTED
77 LOGICAL, INTENT( OUT ) :: DO_MCAST2_TERMBWD
78 include 'mpif.h'
79 include 'mumps_tags.h'
80 INTEGER IERR
81 LOGICAL FLAG
82 include 'mumps_headers.h'
83 LOGICAL COMPRESS_PANEL, LR_ACTIVATED
84 LOGICAL OOCWRITE_COMPATIBLE_WITH_BLR
85 LOGICAL LTLEVEL2, IN_SUBTREE
86 INTEGER TYPENODE
87 INTEGER TMP_NBPANELS, I_PIVRPTR, I_PIVR
88 LOGICAL MUST_BE_PERMUTED
89 LOGICAL NO_CHILDREN
90 LOGICAL :: ALLOW_OTHERS_TO_LEAVE
91 INTEGER :: K, JBDEB, JBFIN, NRHS_B
92 INTEGER IWHDLR
93 INTEGER NPIV
94 INTEGER IPOS,LIELL,NELIM,JJ,I
95 INTEGER J1,J2,J,NCB
96 INTEGER NSLAVES
97 INTEGER IN,IF,LONG,POOL_FIRST_POS,TMP
98 INTEGER :: NBFILS
99 INTEGER :: PROCDEST, DEST
100 INTEGER(8) :: PTWCB, PPIV_COURANT
101 INTEGER :: Offset, EffectiveSize, ISLAVE, FirstIndex
102 INTEGER :: POSINDICES, IPOSINRHSCOMP, IPOSINRHSCOMP_PANEL
103 INTEGER(8) :: APOS, IST
104 INTEGER(8) :: IFR8
105 INTEGER(8) :: APOSDEB, NBENTRIES_ALLPANELS
106 INTEGER(8) :: PTWCB_PANEL
107 INTEGER LDAJ, NBJ, LIWFAC,
108 & NBJLAST, NPIV_LAST, PANEL_SIZE,
109 & NCB_PANEL, TYPEF
110 INTEGER BEG_PANEL
111 LOGICAL TWOBYTWO
112 INTEGER NPANELS, IPANEL
113 REAL ALPHA,ONE,ZERO
114 parameter(zero=0.0e0, one = 1.0e0, alpha=-1.0e0)
115 LOGICAL, EXTERNAL :: MUMPS_IN_OR_ROOT_SSARBR
116 INTEGER, EXTERNAL :: MUMPS_TYPENODE
117 INTEGER, EXTERNAL :: MUMPS_PROCNODE
118 error_was_broadcasted = .false.
119 do_mcast2_termbwd = .false.
120 no_children = .false.
121 IF (do_nbsparse) THEN
122 jbdeb= rhs_bounds(2*step(inode)-1)
123 jbfin= rhs_bounds(2*step(inode))
124 nrhs_b = jbfin-jbdeb+1
125 ELSE
126 jbdeb = 1
127 jbfin = nrhs
128 nrhs_b = nrhs
129 ENDIF
130 IF ( inode .EQ. keep( 38 ) .OR. inode .EQ. keep( 20 ) ) THEN
131 ipos = ptrist(step(inode))+keep(ixsz)
132 npiv = iw(ipos+3)
133 liell = iw(ipos) + npiv
134 ipos = ptrist(step(inode)) + 5 + keep(ixsz)
135 IF ( mtype .EQ. 1 .AND. keep(50) .EQ. 0) THEN
136 j1 = ipos + liell + 1
137 j2 = ipos + liell + npiv
138 ELSE
139 j1 = ipos + 1
140 j2 = ipos + npiv
141 END IF
142 ifr8 = 0_8
143 iposinrhscomp = posinrhscomp_bwd(iw(j1))
144 CALL smumps_sol_cpy_fs2rhscomp(jbdeb, jbfin, j2-j1+1,
145 & keep, rhscomp, nrhs, lrhscomp, iposinrhscomp,
146 & rhs_root(1+npiv*(jbdeb-1)), npiv, 1)
147 in = inode
148 270 in = fils(in)
149 IF (in .GT. 0) GOTO 270
150 IF (in .EQ. 0) THEN
151 myleaf_left = myleaf_left - 1
152 allow_others_to_leave = ( myleaf_left .EQ. 0 .AND.
153 & keep(31) .EQ. 0)
154 IF (keep(31) .NE. 0) THEN
155 IF ( .NOT. mumps_in_or_root_ssarbr(
156 & procnode_steps(step(inode)), keep(199) ) ) THEN
157 keep(31) = keep(31) - 1
158 IF (keep(31) .EQ. 1) THEN
159 allow_others_to_leave = .true.
160 ENDIF
161 ENDIF
162 ENDIF
163 IF (allow_others_to_leave) THEN
164 do_mcast2_termbwd = .true.
165 nbfinf = nbfinf - 1
166 ENDIF
167 RETURN
168 ENDIF
169 IF = -in
170 long = npiv
171 nbfils = ne_steps(step(inode))
172 IF ( prun_below ) THEN
173 i = nbfils
174 nbfils = 0
175 DO WHILE (i.GT.0)
176 IF ( to_process(step(if)) ) nbfils = nbfils+1
177 IF = frere(step(if))
178 i = i -1
179 ENDDO
180 IF (nbfils.EQ.0) THEN
181 no_children = .true.
182 ELSE
183 no_children = .false.
184 ENDIF
185 IF = -in
186 ENDIF
187 DO i = 0, slavef - 1
188 deja_send( i ) = .false.
189 END DO
190 pool_first_pos=iipool
191 DO i = 1, nbfils
192 IF ( prun_below ) THEN
193 1030 IF ( .NOT.to_process(step(if)) ) THEN
194 IF = frere(step(if))
195 GOTO 1030
196 ENDIF
197 no_children = .false.
198 ENDIF
199 IF (mumps_procnode(procnode_steps(step(if)),keep(199))
200 & .EQ. myid) THEN
201 ipool(iipool) = IF
202 iipool = iipool + 1
203 ELSE
204 procdest = mumps_procnode(procnode_steps(step(if)),
205 & keep(199))
206 IF (.NOT. deja_send( procdest )) THEN
207 600 CONTINUE
208 CALL smumps_buf_send_vcb( nrhs_b, IF, 0, 0,
209 & long, long, iw( j1 ),
210 & rhs_root( 1+npiv*(jbdeb-1) ),
211 & jbdeb, jbfin,
212 & rhscomp(1, 1), nrhs, lrhscomp,
213 & iposinrhscomp, npiv,
214 & keep, procdest,
215 & noeud, comm, ierr )
216 IF ( ierr .EQ. -1 ) THEN
217 CALL smumps_backslv_recv_and_treat(
218 & .false., flag,
219 & bufr, lbufr, lbufr_bytes,
220 & myid, slavef, comm,
221 & n, iwcb, liww, posiwcb,
222 & w, lwc, poswcb,
223 & iipool, nbfinf, ptricb, ptracb, info,
224 & ipool, lpool, panel_pos, lpanel_pos,
225 & step, frere, fils, procnode_steps,
226 & pleftw, keep,keep8, dkeep,
227 & ptrist, ptrfac, iw, liw, a, la, w2,
228 & myleaf_left,
229 & nrhs, mtype,
230 & rhscomp, lrhscomp, posinrhscomp_bwd,
231 & prun_below, to_process, size_to_process
232 & , from_pp
233 & )
234 IF ( info( 1 ) .LT. 0 ) THEN
235 error_was_broadcasted = .true.
236 RETURN
237 ENDIF
238 GOTO 600
239 ELSE IF ( ierr .EQ. -2 ) THEN
240 info( 1 ) = -17
241 info( 2 ) = nrhs_b * long * keep(35) +
242 & ( long + 4 ) * keep(34)
243 error_was_broadcasted = .false.
244 RETURN
245 ELSE IF ( ierr .EQ. -3 ) THEN
246 info( 1 ) = -20
247 info( 2 ) = nrhs_b * long * keep(35) +
248 & ( long + 4 ) * keep(34)
249 error_was_broadcasted = .false.
250 RETURN
251 ELSE IF ( ierr .NE. 0 ) THEN
252 WRITE(*,*) "Internal error 2 SMUMPS_SOLVE_NODE_BWD",
253 & ierr
254 CALL mumps_abort()
255 END IF
256 deja_send( procdest ) = .true.
257 END IF
258 ENDIF
259 IF = frere(step(if))
260 ENDDO
261 allow_others_to_leave = .false.
262 IF ( prun_below .AND. no_children ) THEN
263 myleaf_left = myleaf_left - 1
264 allow_others_to_leave = ( myleaf_left .EQ. 0 .AND.
265 & keep(31) .EQ. 0)
266 ENDIF
267 IF ( keep(31). ne. 0) THEN
268 IF ( .NOT. mumps_in_or_root_ssarbr(
269 & procnode_steps(step(inode)), keep(199) ) ) THEN
270 keep(31) = keep(31) - 1
271 IF (keep(31) .EQ. 1) THEN
272 allow_others_to_leave = .true.
273 ENDIF
274 ENDIF
275 ENDIF
276 IF ( allow_others_to_leave ) THEN
277 do_mcast2_termbwd = .true.
278 nbfinf = nbfinf - 1
279 ENDIF
280 IF (iipool.NE.pool_first_pos) THEN
281 DO i=1,(iipool-pool_first_pos)/2
282 tmp = ipool(pool_first_pos+i-1)
283 ipool(pool_first_pos+i-1) = ipool(iipool-i)
284 ipool(iipool-i) = tmp
285 ENDDO
286 ENDIF
287 RETURN
288 END IF
289 in_subtree = mumps_in_or_root_ssarbr(
290 & procnode_steps(step(inode)), keep(199) )
291 typenode = mumps_typenode(procnode_steps(step(inode)),
292 & keep(199))
293 ltlevel2= (
294 & (typenode .eq.2 ) .AND.
295 & (mtype.NE.1) )
296 npiv = iw(ptrist(step(inode))+2+keep(ixsz)+1)
297 IF ((npiv.NE.0).AND.(ltlevel2)) THEN
298 ipos = ptrist(step(inode)) + 2 + keep(ixsz)
299 liell = iw(ipos-2)+iw(ipos+1)
300 nelim = iw(ipos-1)
301 ipos = ipos + 1
302 npiv = iw(ipos)
303 ncb = liell - npiv - nelim
304 ipos = ipos + 2
305 nslaves = iw( ipos )
306 offset = 0
307 ipos = ipos + nslaves
308 iw(ptrist(step(inode))+xxs)= c_fini+nslaves
309 IF ( posiwcb - 2 .LT. 0 .or.
310 & poswcb-int(ncb,8)*int(nrhs_b,8) .LT. pleftw-1_8 ) THEN
311 CALL smumps_compso( n, keep(28), iwcb, liww, w, lwc,
312 & poswcb, posiwcb, ptricb, ptracb)
313 IF ( poswcb-int(ncb,8)*int(nrhs_b,8) .LT. pleftw-1_8 ) THEN
314 info( 1 ) = -11
315 CALL mumps_set_ierror(ncb * nrhs_b - poswcb-pleftw+1_8,
316 & info(2))
317 error_was_broadcasted = .false.
318 RETURN
319 END IF
320 IF ( posiwcb - 2 .LT. 0 ) THEN
321 info( 1 ) = -14
322 info( 2 ) = 2 - posiwcb
323 error_was_broadcasted = .false.
324 RETURN
325 END IF
326 END IF
327 posiwcb = posiwcb - 2
328 poswcb = poswcb - int(ncb,8)*int(nrhs_b,8)
329 ptricb(step( inode )) = posiwcb + 1
330 ptracb(step( inode )) = poswcb + 1_8
331 iwcb( ptricb(step( inode )) ) = ncb*nrhs_b
332 iwcb( ptricb(step( inode )) + 1 ) = 1
333 IF ( mtype.EQ.1 .AND. keep(50).EQ.0 ) THEN
334 posindices = ipos + liell + 1
335 ELSE
336 posindices = ipos + 1
337 END IF
338 IF ( ncb.EQ.0 ) THEN
339 write(6,*) ' Internal Error type 2 node with no CB '
340 CALL mumps_abort()
341 ENDIF
342 IF ( mtype .EQ. 1 .AND. keep(50).EQ.0 ) THEN
343 j1 = ipos + liell + npiv + nelim +1
344 j2 = ipos + 2 * liell
345 ELSE
346 j1 = ipos + npiv + nelim +1
347 j2 = ipos + liell
348 END IF
349 ifr8 = ptracb(step( inode )) - 1_8
350 CALL smumps_sol_bwd_gthr( jbdeb, jbfin, j1, j2,
351 & rhscomp, nrhs, lrhscomp,
352 & w(ptracb(step(inode))), ncb, 1,
353 & iw, liw, keep, n, posinrhscomp_bwd )
354 ifr8 = ifr8 + int(j2-keep(253)-j1+1,8)
355 IF (keep(252).NE.0) THEN
356 DO jj = j2-keep(253)+1, j2
357 ifr8 = ifr8 + 1_8
358 DO k=jbdeb, jbfin
359 IF (k.EQ.jj-j2+keep(253)) THEN
360 w(ifr8+int(k-jbdeb,8)*int(ncb,8)) = alpha
361 ELSE
362 w(ifr8+int(k-jbdeb,8)*int(ncb,8)) = zero
363 ENDIF
364 ENDDO
365 ENDDO
366 ENDIF
367 DO islave = 1, nslaves
368 CALL mumps_bloc2_get_slave_info(
369 & keep,keep8, inode, step, n, slavef,
370 & istep_to_iniv2, tab_pos_in_pere,
371 & islave, ncb,
372 & nslaves,
373 & effectivesize,
374 & firstindex )
375 500 CONTINUE
376 dest = iw( ptrist(step(inode))+5+islave+keep(ixsz))
377 CALL smumps_buf_send_backvec(nrhs_b, inode,
378 & w(offset+ptracb(step(inode))),
379 & effectivesize,
380 & ncb, dest,
381 & backslv_master2slave, jbdeb, jbfin,
382 & keep, comm, ierr )
383 IF ( ierr .EQ. -1 ) THEN
384 CALL smumps_backslv_recv_and_treat(
385 & .false., flag,
386 & bufr, lbufr, lbufr_bytes,
387 & myid, slavef, comm,
388 & n, iwcb, liww, posiwcb,
389 & w, lwc, poswcb,
390 & iipool, nbfinf, ptricb, ptracb, info,
391 & ipool, lpool, panel_pos, lpanel_pos,
392 & step, frere, fils,
393 & procnode_steps, pleftw, keep,keep8, dkeep,
394 & ptrist, ptrfac, iw, liw, a, la, w2, myleaf_left,
395 & nrhs, mtype,
396 & rhscomp, lrhscomp, posinrhscomp_bwd,
397 & prun_below , to_process, size_to_process
398 & , from_pp
399 & )
400 IF ( info( 1 ) .LT. 0 ) THEN
401 error_was_broadcasted = .true.
402 RETURN
403 ENDIF
404 GOTO 500
405 ELSE IF ( ierr .EQ. -2 ) THEN
406 info( 1 ) = -17
407 info( 2 ) = nrhs_b * effectivesize * keep(35) +
408 & 2 * keep(34)
409 error_was_broadcasted = .false.
410 RETURN
411 ELSE IF ( ierr .EQ. -3 ) THEN
412 info( 1 ) = -20
413 info( 2 ) = nrhs_b * effectivesize * keep(35) +
414 & 2 * keep(34)
415 error_was_broadcasted = .false.
416 RETURN
417 END IF
418 offset = offset + effectivesize
419 END DO
420 iwcb( ptricb(step( inode )) + 1 ) = 0
421 CALL smumps_freetopso(n, keep(28), iwcb, liww, w, lwc,
422 & poswcb,posiwcb,ptricb,ptracb)
423 RETURN
424 ENDIF
425 lr_activated = (iw(ptrist(step(inode))+xxlr).GT.0)
426 compress_panel = (iw(ptrist(step(inode))+xxlr).GE.2)
427 oocwrite_compatible_with_blr =
428 & (.NOT.lr_activated.OR.(.NOT.compress_panel).OR.
429 & (keep(485).EQ.0)
430 & )
431 ipos = ptrist(step(inode)) + 2 + keep(ixsz)
432 liell = iw(ipos-2)+iw(ipos+1)
433 nelim = iw(ipos-1)
434 ipos = ipos + 1
435 npiv = iw(ipos)
436 ncb = liell - npiv
437 ipos = ipos + 1
438 IF (keep(201).GT.0.AND.oocwrite_compatible_with_blr) THEN
439 CALL smumps_solve_get_ooc_node(
440 & inode,ptrfac,keep,a,la,step,
441 & keep8,n,must_be_permuted,ierr)
442 IF(ierr.LT.0)THEN
443 info(1)=ierr
444 info(2)=0
445 error_was_broadcasted = .false.
446 RETURN
447 ENDIF
448 ENDIF
449 apos = ptrfac( step(inode))
450 nslaves = iw( ptrist(step(inode)) + 5 + keep(ixsz) )
451 ipos = ipos + 1 + nslaves
452 IF (keep(201).EQ.1.AND.oocwrite_compatible_with_blr) THEN
453 liwfac = iw(ptrist(step(inode))+xxi)
454 IF (mtype.NE.1) THEN
455 typef = typef_l
456 ELSE
457 typef = typef_u
458 ENDIF
459 panel_size = smumps_ooc_panel_size( liell )
460 IF (keep(50).NE.1) THEN
461 CALL smumps_ooc_pp_check_perm_freed(
462 & iw(ipos+1+2*liell),
463 & must_be_permuted )
464 ENDIF
465 ENDIF
466 long = 0
467 IF ( mtype .EQ. 1 .AND. keep(50).EQ.0 ) THEN
468 j1 = ipos + liell + 1
469 j2 = ipos + npiv + liell
470 ELSE
471 j1 = ipos + 1
472 j2 = ipos + npiv
473 ENDIF
474 IF (in_subtree) THEN
475 ptwcb = pleftw
476 IF ( poswcb .LT. int(liell,8)*int(nrhs_b,8) ) THEN
477 CALL smumps_compso( n, keep(28), iwcb, liww, w, lwc,
478 & poswcb, posiwcb, ptricb, ptracb)
479 IF ( poswcb .LT. int(liell,8)*int(nrhs_b,8) ) THEN
480 info(1) = -11
481 CALL mumps_set_ierror(int(liell,8)*int(nrhs_b,8)-poswcb,
482 & info(2))
483 error_was_broadcasted = .false.
484 RETURN
485 END IF
486 END IF
487 ELSE
488 IF ( posiwcb - 2 .LT. 0 .or.
489 & poswcb-int(liell,8)*int(nrhs_b,8) .LT. pleftw-1_8 ) THEN
490 CALL smumps_compso( n, keep(28), iwcb, liww, w, lwc,
491 & poswcb, posiwcb, ptricb, ptracb )
492 IF ( poswcb-int(liell,8)*int(nrhs_b,8) .LT. pleftw-1_8 ) THEN
493 info( 1 ) = -11
494 CALL mumps_set_ierror( int(liell,8)*int(nrhs_b,8)-
495 & poswcb-pleftw+1_8,
496 & info(2) )
497 error_was_broadcasted = .false.
498 RETURN
499 END IF
500 IF ( posiwcb - 2 .LT. 0 ) THEN
501 info( 1 ) = -14
502 info( 2 ) = 2 - posiwcb
503 error_was_broadcasted = .false.
504 RETURN
505 END IF
506 END IF
507 posiwcb = posiwcb - 2
508 poswcb = poswcb - int(liell,8)*int(nrhs_b,8)
509 ptricb(step( inode )) = posiwcb + 1
510 ptracb(step( inode )) = poswcb + 1_8
511 iwcb( ptricb(step( inode )) ) = liell*nrhs_b
512 iwcb( ptricb(step( inode )) + 1 ) = 1
513 IF ( mtype.EQ.1 .AND. keep(50).EQ.0 ) THEN
514 posindices = ipos + liell + 1
515 ELSE
516 posindices = ipos + 1
517 END IF
518 ptwcb = ptracb(step( inode ))
519 ENDIF
520 IF (j2.GE.j1) THEN
521 iposinrhscomp = posinrhscomp_bwd(iw(j1))
522 ELSE
523 iposinrhscomp = -99999
524 ENDIF
525 IF (j2.GE.j1) THEN
526 DO k=jbdeb, jbfin
527 IF (keep(252).NE.0) THEN
528 DO jj = j1, j2
529 rhscomp(iposinrhscomp+jj-j1,k) = zero
530 ENDDO
531 ENDIF
532 END DO
533 ENDIF
534 ifr8 = ptwcb + int(npiv - 1,8)
535 IF ( liell .GT. npiv ) THEN
536 IF ( mtype .EQ. 1 .AND. keep(50).EQ.0 ) THEN
537 j1 = ipos + liell + npiv + 1
538 j2 = ipos + 2 * liell
539 ELSE
540 j1 = ipos + npiv + 1
541 j2 = ipos + liell
542 END IF
543 CALL smumps_sol_bwd_gthr( jbdeb, jbfin, j1, j2,
544 & rhscomp, nrhs, lrhscomp,
545 & w(ptwcb), liell, npiv+1,
546 & iw, liw, keep, n, posinrhscomp_bwd )
547 ifr8 = ifr8 + int(j2-keep(253)-j1+1,8)
548 IF (keep(252).NE.0) THEN
549 DO jj = j2-keep(253)+1, j2
550 ifr8 = ifr8 + 1_8
551 DO k=jbdeb, jbfin
552 IF (k.EQ.jj-j2+keep(253)) THEN
553 w(ifr8+int(k-jbdeb,8)*int(liell,8)) = alpha
554 ELSE
555 w(ifr8+int(k-jbdeb,8)*int(liell,8)) = zero
556 ENDIF
557 ENDDO
558 ENDDO
559 ENDIF
560 ncb = liell - npiv
561 IF (npiv .EQ. 0) GOTO 160
562 ENDIF
563 IF (keep(201).EQ.1.AND.oocwrite_compatible_with_blr) THEN
564 j = npiv / panel_size
565 twobytwo = keep(50).EQ.2 .AND.
566 & ((typenode.EQ.1.AND.keep(103).GT.0) .OR.
567 & (typenode.EQ.2.AND.keep(105).GT.0))
568 IF (twobytwo) THEN
569 CALL smumps_build_panel_pos(panel_size, panel_pos, lpanel_pos,
570 & iw(ipos+1+liell), npiv, npanels, liell,
571 & nbentries_allpanels)
572 ELSE
573 IF (npiv.EQ.j*panel_size) THEN
574 npiv_last = npiv
575 nbjlast = panel_size
576 npanels = j
577 ELSE
578 npiv_last = (j+1)* panel_size
579 nbjlast = npiv-j*panel_size
580 npanels = j+1
581 ENDIF
582 nbentries_allpanels =
583 & int(liell,8) * int(npiv,8)
584 & - int( ( j * ( j - 1 ) ) /2,8 )
585 & * int(panel_size,8) * int(panel_size,8)
586 & - int(j,8)
587 & * int(mod(npiv, panel_size),8)
588 & * int(panel_size,8)
589 jj=npiv_last
590 ENDIF
591 aposdeb = apos + nbentries_allpanels
592 DO ipanel = npanels, 1, -1
593 IF (twobytwo) THEN
594 nbj = panel_pos(ipanel+1)-panel_pos(ipanel)
595 beg_panel = panel_pos(ipanel)
596 ELSE
597 IF (jj.EQ.npiv_last) THEN
598 nbj = nbjlast
599 ELSE
600 nbj = panel_size
601 ENDIF
602 beg_panel = jj- panel_size+1
603 ENDIF
604 ldaj = liell-beg_panel+1
605 aposdeb = aposdeb - int(nbj,8)*int(ldaj,8)
606 ptwcb_panel = ptwcb + int(beg_panel - 1,8)
607 iposinrhscomp_panel = iposinrhscomp + beg_panel - 1
608 ncb_panel = ldaj - nbj
609 IF (keep(50).NE.1.AND.must_be_permuted) THEN
610 CALL smumps_get_ooc_perm_ptr(typef, tmp_nbpanels,
611 & i_pivrptr, i_pivr, ipos + 1 + 2 * liell, iw, liw)
612 IF (npiv.EQ.(iw(i_pivrptr)-1)) THEN
613 must_be_permuted=.false.
614 ELSE
615 CALL smumps_permute_panel(
616 & iw(i_pivr + iw(i_pivrptr+ipanel-1)-iw(i_pivrptr)),
617 & npiv-iw(i_pivrptr+ipanel-1)+1,
618 & iw(i_pivrptr+ipanel-1)-1,
619 & a(aposdeb),
620 & ldaj, nbj, beg_panel-1)
621 ENDIF
622 ENDIF
623#if defined(MUMPS_USE_BLAS2)
624 IF ( nrhs_b == 1 ) THEN
625 IF (ncb_panel.NE.0) THEN
626 IF (ncb_panel - ncb.NE. 0) THEN
627 CALL sgemv( 'T', ncb_panel-ncb, nbj, alpha,
628 & a( aposdeb + int(nbj,8) ), ldaj,
629 & rhscomp(iposinrhscomp_panel+nbj,jbdeb),
630 & 1, one,
631 & rhscomp(iposinrhscomp_panel,jbdeb), 1 )
632 ENDIF
633 IF (ncb .NE. 0) THEN
634 CALL sgemv( 'T', ncb, nbj, alpha,
635 & a( aposdeb + int(ldaj-ncb,8) ), ldaj,
636 & w( ptwcb + int(npiv,8) ),
637 & 1, one,
638 & rhscomp(iposinrhscomp_panel,jbdeb), 1 )
639 ENDIF
640 ENDIF
641 IF (mtype.NE.1) THEN
642 CALL strsv('L','T','U', nbj, a(aposdeb), ldaj,
643 & rhscomp(iposinrhscomp_panel,jbdeb), 1)
644 ELSE
645 CALL strsv('L','T','N', nbj, a(aposdeb), ldaj,
646 & rhscomp(iposinrhscomp_panel,jbdeb), 1)
647 ENDIF
648 ELSE
649#endif
650 IF (ncb_panel.NE.0) THEN
651 IF (ncb_panel - ncb .NE. 0) THEN
652 CALL sgemm( 'T', 'N', nbj, nrhs_b,
653 & ncb_panel-ncb, alpha,
654 & a(aposdeb +int(nbj,8)), ldaj,
655 & rhscomp(iposinrhscomp_panel+nbj,jbdeb), lrhscomp,
656 & one, rhscomp(iposinrhscomp_panel,jbdeb), lrhscomp)
657 ENDIF
658 IF (ncb .NE. 0) THEN
659 CALL sgemm( 'T', 'N', nbj, nrhs_b, ncb, alpha,
660 & a(aposdeb +int(ldaj-ncb,8)), ldaj,
661 & w( ptwcb+int(npiv,8) ), liell,
662 & one, rhscomp(iposinrhscomp_panel,jbdeb),lrhscomp)
663 ENDIF
664 ENDIF
665 IF (mtype.NE.1) THEN
666 CALL strsm('L','L','T','U',nbj, nrhs_b, one,
667 & a(aposdeb),
668 & ldaj, rhscomp(iposinrhscomp_panel,jbdeb), lrhscomp)
669 ELSE
670 CALL strsm('L','L','T','N',nbj, nrhs_b, one,
671 & a(aposdeb),
672 & ldaj, rhscomp(iposinrhscomp_panel,jbdeb), lrhscomp)
673 ENDIF
674#if defined(MUMPS_USE_BLAS2)
675 ENDIF
676#endif
677 IF (.NOT. twobytwo) jj=beg_panel-1
678 ENDDO
679 ELSE
680 IF ( iw(ptrist(step(inode))+xxlr) .GE. 2
681 & .AND. keep(485) .EQ. 1 ) THEN
682 iwhdlr = iw(ptrist(step(inode))+xxf)
683 CALL smumps_sol_bwd_lr_su (
684 & inode, iwhdlr, npiv, nslaves,
685 & liell, w, lwc, nrhs_b, ptwcb,
686 & rhscomp, lrhscomp, nrhs,
687 & iposinrhscomp, jbdeb,
688 & mtype, keep, keep8,
689 & info(1), info(2) )
690 IF (info(1).LT.0) THEN
691 error_was_broadcasted = .false.
692 RETURN
693 ENDIF
694 ELSE
695 IF ( liell .GT. npiv ) THEN
696#if defined(LDLTPANEL_DEBUG)
697 WRITE(*,*) 'before gemm LIELL, NPIV, PTWCB=',liell,npiv,ptwcb
698 WRITE(*,*) 'before gemm RHSCOMP=',
699 & rhscomp(iposinrhscomp:iposinrhscomp+npiv-1,1)
700 WRITE(*,*) 'before gemm W',
701 & w(ptwcb+npiv:ptwcb+liell-1)
702 CALL mumps_geti8(ist, iw(ptrist(step(inode))+xxr))
703 WRITE(*,*) "FACTORS=",a(apos:apos+ist-1)
704#endif
705 IF ( mtype .eq. 1 ) THEN
706 ist = apos + int(npiv,8)
707#if defined(MUMPS_USE_BLAS2)
708 IF (nrhs_b == 1) THEN
709 CALL sgemv( 'T', ncb, npiv, alpha, a(ist), liell,
710 & w(ptwcb+int(npiv,8)), 1,
711 & one,
712 & rhscomp(iposinrhscomp,jbdeb), 1 )
713 ELSE
714#endif
715 CALL sgemm('T','N', npiv, nrhs_b, ncb, alpha,
716 & a(ist),
717 & liell, w(ptwcb+int(npiv,8)), liell, one,
718 & rhscomp(iposinrhscomp,jbdeb), lrhscomp)
719#if defined(MUMPS_USE_BLAS2)
720 ENDIF
721#endif
722 ELSE
723 IF ( keep(50) .eq. 0 ) THEN
724 ist = apos + int(npiv,8) * int(liell,8)
725 ELSE
726 IF( keep(459) .GT. 1) THEN
727 CALL mumps_geti8(ist, iw(ptrist(step(inode))+xxr))
728 ist = apos + ist - int(npiv,8) * int(liell-npiv,8)
729 ELSE
730 ist = apos + int(npiv,8) * int(npiv,8)
731 ENDIF
732 END IF
733#if defined(MUMPS_USE_BLAS2)
734 IF ( nrhs_b == 1 ) THEN
735 CALL sgemv( 'N', npiv, ncb, alpha, a( ist ), npiv,
736 & w( ptwcb + int(npiv,8) ),
737 & 1, one,
738 & rhscomp(iposinrhscomp,jbdeb), 1 )
739 ELSE
740#endif
741 CALL sgemm( 'N', 'N', npiv, nrhs_b, ncb, alpha,
742 & a(ist),
743 & npiv, w(ptwcb+int(npiv,8)), liell,
744 & one, rhscomp(iposinrhscomp,jbdeb), lrhscomp)
745#if defined(MUMPS_USE_BLAS2)
746 END IF
747#endif
748 END IF
749 ENDIF
750 IF ( mtype .eq. 1 ) THEN
751 ldaj = liell
752 ELSE
753 IF ( keep(50) .EQ. 0 ) THEN
754 ldaj=liell
755 ELSE
756 IF (keep(459).GT.1) THEN
757 ldaj=-999799
758 ELSE
759 ldaj=npiv
760 ENDIF
761 ENDIF
762 END IF
763 ppiv_courant = int(jbdeb-1,8)*int(lrhscomp,8)
764 & + int(iposinrhscomp,8)
765 IF (keep(459).GT.1 .AND. keep(50).NE.0) THEN
766 CALL smumps_solve_bwd_panels( a, la, apos,
767 & npiv, iw(ipos+1+liell),
768 & nrhs_b, rhscomp(1,1), keep8(25), lrhscomp, ppiv_courant,
769 & mtype, keep )
770 ELSE
771 CALL smumps_solve_bwd_trsolve( a, la, apos,
772 & npiv, ldaj,
773 & nrhs_b, rhscomp(1,1), keep8(25), lrhscomp, ppiv_courant,
774 & mtype, keep )
775 ENDIF
776 ENDIF
777 ENDIF
778 IF ( mtype .EQ. 1 .AND. keep(50).EQ.0) THEN
779 j1 = ipos + liell + 1
780 ELSE
781 j1 = ipos + 1
782 END IF
783 iposinrhscomp = posinrhscomp_bwd(iw(j1))
784 160 CONTINUE
785 IF (keep(201).GT.0.AND.oocwrite_compatible_with_blr) THEN
786 CALL smumps_free_factors_for_solve(inode,ptrfac,keep(28),
787 & a,la,.true.,ierr)
788 IF(ierr.LT.0)THEN
789 info(1)=ierr
790 info(2)=0
791 error_was_broadcasted = .false.
792 RETURN
793 ENDIF
794 ENDIF
795 in = inode
796 170 in = fils(in)
797 IF (in .GT. 0) GOTO 170
798 IF (in .EQ. 0) THEN
799 myleaf_left = myleaf_left - 1
800 IF (.NOT. in_subtree ) THEN
801 iwcb(ptricb(step(inode))+1) = iwcb(ptricb(step(inode))+1)-1
802 CALL smumps_freetopso(n, keep(28), iwcb, liww,
803 & w, lwc,
804 & poswcb,posiwcb,ptricb,ptracb)
805 ENDIF
806 allow_others_to_leave = ( myleaf_left .EQ. 0 .AND.
807 & keep(31) .EQ. 0)
808 IF ( keep(31) .NE. 0 .AND.
809 & .NOT. in_subtree ) THEN
810 keep(31) = keep(31) - 1
811 IF (keep(31).EQ. 1) THEN
812 allow_others_to_leave = .true.
813 ENDIF
814 ENDIF
815 IF (allow_others_to_leave) THEN
816 do_mcast2_termbwd = .true.
817 nbfinf = nbfinf - 1
818 ENDIF
819 RETURN
820 ENDIF
821 IF = -in
822 nbfils = ne_steps(step(inode))
823 IF ( prun_below ) THEN
824 i = nbfils
825 nbfils = 0
826 DO WHILE (i.GT.0)
827 IF ( to_process(step(if)) ) nbfils = nbfils+1
828 IF = frere(step(if))
829 i = i -1
830 ENDDO
831 IF (nbfils.EQ.0) THEN
832 no_children = .true.
833 ELSE
834 no_children = .false.
835 ENDIF
836 IF = -in
837 ENDIF
838 IF (in_subtree) THEN
839 DO i = 1, nbfils
840 IF ( prun_below ) THEN
841 1010 CONTINUE
842 IF ( .NOT.to_process(step(if)) ) THEN
843 IF = frere(step(if))
844 GOTO 1010
845 ENDIF
846 no_children = .false.
847 ENDIF
848 ipool((iipool-i+1)+nbfils-i) = IF
849 iipool = iipool + 1
850 IF = frere(step(if))
851 ENDDO
852 IF (prun_below .AND. no_children) THEN
853 myleaf_left = myleaf_left - 1
854 allow_others_to_leave = ( myleaf_left .EQ. 0 .AND.
855 & keep(31) .EQ. 0)
856 IF (allow_others_to_leave ) THEN
857 do_mcast2_termbwd = .true.
858 nbfinf = nbfinf - 1
859 RETURN
860 ENDIF
861 ENDIF
862 ELSE
863 DO i = 0, slavef - 1
864 deja_send( i ) = .false.
865 END DO
866 pool_first_pos=iipool
867 DO 190 i = 1, nbfils
868 IF ( prun_below ) THEN
8691020 IF ( .NOT.to_process(step(if)) ) THEN
870 IF = frere(step(if))
871 GOTO 1020
872 ENDIF
873 no_children = .false.
874 ENDIF
875 IF (mumps_procnode(procnode_steps(step(if)),
876 & keep(199)) .EQ. myid) THEN
877 ipool(iipool) = IF
878 iipool = iipool + 1
879 IF = frere(step(if))
880 ELSE
881 procdest = mumps_procnode(procnode_steps(step(if)),
882 & keep(199))
883 IF (.not. deja_send( procdest )) THEN
884 400 CONTINUE
885 CALL smumps_buf_send_vcb( nrhs_b, IF, 0, 0,
886 & liell, liell - keep(253),
887 & iw( posindices ),
888 & w( ptracb(step(inode)) ), jbdeb, jbfin,
889 & rhscomp(1, 1), nrhs, lrhscomp,
890 & iposinrhscomp, npiv,
891 & keep, procdest, noeud, comm, ierr )
892 IF ( ierr .EQ. -1 ) THEN
893 CALL smumps_backslv_recv_and_treat(
894 & .false., flag,
895 & bufr, lbufr, lbufr_bytes,
896 & myid, slavef, comm,
897 & n, iwcb, liww, posiwcb,
898 & w, lwc, poswcb,
899 & iipool, nbfinf, ptricb, ptracb, info,
900 & ipool, lpool, panel_pos, lpanel_pos,
901 & step, frere, fils, procnode_steps,
902 & pleftw, keep, keep8, dkeep,
903 & ptrist, ptrfac, iw, liw, a, la, w2, myleaf_left,
904 & nrhs, mtype,
905 & rhscomp, lrhscomp, posinrhscomp_bwd,
906 & prun_below, to_process, size_to_process
907 & , from_pp
908 & )
909 IF ( info( 1 ) .LT. 0 ) THEN
910 error_was_broadcasted = .true.
911 RETURN
912 ENDIF
913 GOTO 400
914 ELSE IF ( ierr .EQ. -2 ) THEN
915 info( 1 ) = -17
916 info( 2 ) = nrhs_b * liell * keep(35) + 4 * keep(34)
917 error_was_broadcasted = .false.
918 RETURN
919 ELSE IF ( ierr .EQ. -3 ) THEN
920 info( 1 ) = -20
921 info( 2 ) = nrhs_b * liell * keep(35) + 4 * keep(34)
922 error_was_broadcasted = .false.
923 RETURN
924 END IF
925 deja_send( procdest ) = .true.
926 END IF
927 IF = frere(step(if))
928 ENDIF
929 190 CONTINUE
930 IF ( prun_below .AND. no_children ) THEN
931 myleaf_left = myleaf_left - 1
932 allow_others_to_leave = ( myleaf_left .EQ. 0 .AND.
933 & keep(31) .EQ. 0)
934 IF ( allow_others_to_leave ) THEN
935 do_mcast2_termbwd = .true.
936 nbfinf = nbfinf - 1
937 RETURN
938 ENDIF
939 ENDIF
940 DO i=1,(iipool-pool_first_pos)/2
941 tmp=ipool(pool_first_pos+i-1)
942 ipool(pool_first_pos+i-1)=ipool(iipool-i)
943 ipool(iipool-i)=tmp
944 ENDDO
945 IF ( keep(31) .NE. 0 )
946 & THEN
947 keep(31) = keep(31) - 1
948 allow_others_to_leave = (keep(31) .EQ. 1)
949 IF (allow_others_to_leave) THEN
950 do_mcast2_termbwd = .true.
951 nbfinf = nbfinf - 1
952 ENDIF
953 ENDIF
954 iwcb(ptricb(step(inode))+1) = iwcb(ptricb(step(inode))+1)-1
955 CALL smumps_freetopso(n, keep(28), iwcb, liww,
956 & w, lwc,
957 & poswcb,posiwcb,ptricb,ptracb)
958 ENDIF
959 RETURN
if
if(complex_arithmetic) id
sgemv
subroutine sgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
SGEMV
Definition sgemv.f:156
strsv
subroutine strsv(uplo, trans, diag, n, a, lda, x, incx)
STRSV
Definition strsv.f:149
strsm
subroutine strsm(side, uplo, transa, diag, m, n, alpha, a, lda, b, ldb)
STRSM
Definition strsm.f:181
sgemm
subroutine sgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
SGEMM
Definition sgemm.f:187
mumps_bloc2_get_slave_info
subroutine mumps_bloc2_get_slave_info(keep, keep8, inode, step, n, slavef, istep_to_iniv2, tab_pos_in_pere islave, ncb, nslaves, size, first_index)
Definition mumps_type2_blocking.F:367
smumps_buf::smumps_buf_send_backvec
subroutine, public smumps_buf_send_backvec(nrhs, inode, w, lw, ld_w, dest, msgtag, jbdeb, jbfin, keep, comm, ierr)
Definition smumps_comm_buffer.F:2627
smumps_buf::smumps_buf_send_vcb
subroutine, public smumps_buf_send_vcb(nrhs_b, node1, node2, ncb, ldw, long, iw, w, jbdeb, jbfin, rhscomp, nrhs, lrhscomp, iposinrhscomp, npiv, keep, dest, tag, comm, ierr)
Definition smumps_comm_buffer.F:505
smumps_ooc::smumps_ooc_panel_size
integer function, public smumps_ooc_panel_size(nnmax)
Definition smumps_ooc.F:3404
smumps_ooc::smumps_free_factors_for_solve
subroutine smumps_free_factors_for_solve(inode, ptrfac, nsteps, a, la, flag, ierr)
Definition smumps_ooc.F:1204
smumps_ooc_pp_check_perm_freed
subroutine smumps_ooc_pp_check_perm_freed(iw_location, must_be_permuted)
Definition sooc_panel_piv.F:349
smumps_get_ooc_perm_ptr
subroutine smumps_get_ooc_perm_ptr(typef, nbpanels, i_pivptr, i_piv, ipos, iw, liw)
Definition sooc_panel_piv.F:133
smumps_permute_panel
subroutine smumps_permute_panel(ipiv, lpiv, ishift, the_panel, nbrow, nbcol, kbeforepanel)
Definition sooc_panel_piv.F:78
smumps_compso
subroutine smumps_compso(n, keep28, iwcb, liww, w, lwc, poswcb, iwposcb, ptricb, ptracb)
Definition ssol_aux.F:37
smumps_solve_bwd_panels
subroutine smumps_solve_bwd_panels(a, la, apos, npiv, iw, nrhs_b, wcb, lwcb, lda_wcb, ppiv_courant, mtype, keep)
Definition ssol_aux.F:1274
smumps_solve_bwd_trsolve
subroutine smumps_solve_bwd_trsolve(a, la, apos, npiv, ldadiag, nrhs_b, wcb, lwcb, lda_wcb, ppiv_courant, mtype, keep)
Definition ssol_aux.F:1185
smumps_sol_bwd_gthr
subroutine smumps_sol_bwd_gthr(jbdeb, jbfin, j1, j2, rhscomp, nrhs, lrhscomp, w, ld_w, first_row_w, iw, liw, keep, n, posinrhscomp_bwd)
Definition ssol_aux.F:1063
smumps_freetopso
subroutine smumps_freetopso(n, keep28, iwcb, liww, w, lwc, poswcb, iwposcb, ptricb, ptracb)
Definition ssol_aux.F:17
smumps_solve_get_ooc_node
subroutine smumps_solve_get_ooc_node(inode, ptrfac, keep, a, la, step, keep8, n, must_be_permuted, ierr)
Definition ssol_aux.F:732
smumps_sol_cpy_fs2rhscomp
subroutine smumps_sol_cpy_fs2rhscomp(jbdeb, jbfin, nbrows, keep, rhscomp, nrhs, lrhscomp, first_row_rhscomp, w, ld_w, first_row_w)
Definition ssol_aux.F:1040
smumps_build_panel_pos
subroutine smumps_build_panel_pos(panel_size, panel_pos, len_panel_pos, indices, npiv, npanels, nfront_or_nass, nbentries_allpanels)
Definition ssol_bwd_aux.F:1844
smumps_backslv_recv_and_treat
recursive subroutine smumps_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)
Definition ssol_bwd_aux.F:977
mumps_in_or_root_ssarbr
logical function mumps_in_or_root_ssarbr(procinfo_inode, k199)
Definition tools_common.F:214
mumps_typenode
integer function mumps_typenode(procinfo_inode, k199)
Definition tools_common.F:90
mumps_procnode
integer function mumps_procnode(procinfo_inode, k199)
Definition tools_common.F:151
mumps_set_ierror
subroutine mumps_set_ierror(size8, ierror)
Definition tools_common.F:865
mumps_geti8
subroutine mumps_geti8(i8, int_array)
Definition tools_common.F:888