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

Go to the source code of this file.

Functions/Subroutines

subroutine cmumps_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 cmumps_backslv_recv_and_treat (bloq, flag, bufr, lbufr, lbufr_bytes, myid, slavef, comm, n, iwcb, liww, posiwcb, w, lwc, poswcb, iipool, nbfinf, ptricb, ptracb, info, ipool, lpool, panel_pos, lpanel_pos, step, frere, fils, procnode_steps, pleftw, keep, keep8, dkeep, ptrist, ptrfac, iw, liw, a, la, w2, myleaf_left, nrhs, mtype, rhscomp, lrhscomp, posinrhscomp_bwd, prun_below, to_process, size_to_process, from_pp)
recursive subroutine cmumps_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 cmumps_build_panel_pos (panel_size, panel_pos, len_panel_pos, indices, npiv, npanels, nfront_or_nass, nbentries_allpanels)

Function/Subroutine Documentation

◆ cmumps_backslv_recv_and_treat()

recursive subroutine cmumps_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,
complex, 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,
complex, dimension( la ) a,
integer(8) la,
complex, dimension( keep(133) ) w2,
integer myleaf_left,
integer nrhs,
integer mtype,
complex, 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 963 of file csol_bwd_aux.F.

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

◆ cmumps_backslv_traiter_message()

recursive subroutine cmumps_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,
complex, 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,
complex, dimension( la ) a,
integer(8) la,
complex, dimension( keep(133) ) w2,
integer myleaf_left,
integer nrhs,
integer mtype,
complex, 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 1060 of file csol_bwd_aux.F.

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

◆ cmumps_build_panel_pos()

subroutine cmumps_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 1844 of file csol_bwd_aux.F.

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

◆ cmumps_solve_node_bwd()

subroutine cmumps_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,
complex, dimension( la ) a,
integer(8), intent(in) la,
integer, dimension(liw) iw,
integer, intent(in) liw,
complex, dimension(lwc) w,
integer(8), intent(in) lwc,
integer, intent(in) nrhs,
integer(8), intent(inout) poswcb,
integer(8), intent(inout) pleftw,
integer, intent(inout) posiwcb,
complex, dimension(lrhscomp,nrhs) rhscomp,
integer lrhscomp,
integer, dimension(n) posinrhscomp_bwd,
integer, dimension(keep(28)) ptricb,
integer(8), dimension(keep(28)) ptracb,
integer, dimension(liww) iwcb,
integer, intent(in) liww,
complex, dimension(keep(133)) w2,
integer, dimension(keep(28)), 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,
complex, 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 csol_bwd_aux.F.

32 USE cmumps_ooc
33 USE cmumps_buf
34 USE cmumps_sol_lr, only : cmumps_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 COMPLEX :: A( LA )
57 COMPLEX :: W(LWC)
58 COMPLEX :: 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 COMPLEX RHSCOMP(LRHSCOMP,NRHS)
67 INTEGER(8), intent(in) :: LRHS_ROOT
68 COMPLEX 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 COMPLEX ALPHA,ONE,ZERO
114 parameter(zero=(0.0e0,0.0e0),
115 & one=(1.0e0,0.0e0),
116 & alpha=(-1.0e0,0.0e0))
117 LOGICAL, EXTERNAL :: MUMPS_IN_OR_ROOT_SSARBR
118 INTEGER, EXTERNAL :: MUMPS_TYPENODE
119 INTEGER, EXTERNAL :: MUMPS_PROCNODE
120 error_was_broadcasted = .false.
121 do_mcast2_termbwd = .false.
122 no_children = .false.
123 IF (do_nbsparse) THEN
124 jbdeb= rhs_bounds(2*step(inode)-1)
125 jbfin= rhs_bounds(2*step(inode))
126 nrhs_b = jbfin-jbdeb+1
127 ELSE
128 jbdeb = 1
129 jbfin = nrhs
130 nrhs_b = nrhs
131 ENDIF
132 IF ( inode .EQ. keep( 38 ) .OR. inode .EQ. keep( 20 ) ) THEN
133 ipos = ptrist(step(inode))+keep(ixsz)
134 npiv = iw(ipos+3)
135 liell = iw(ipos) + npiv
136 ipos = ptrist(step(inode)) + 5 + keep(ixsz)
137 IF ( mtype .EQ. 1 .AND. keep(50) .EQ. 0) THEN
138 j1 = ipos + liell + 1
139 j2 = ipos + liell + npiv
140 ELSE
141 j1 = ipos + 1
142 j2 = ipos + npiv
143 END IF
144 ifr8 = 0_8
145 iposinrhscomp = posinrhscomp_bwd(iw(j1))
146 CALL cmumps_sol_cpy_fs2rhscomp(jbdeb, jbfin, j2-j1+1,
147 & keep, rhscomp, nrhs, lrhscomp, iposinrhscomp,
148 & rhs_root(1+npiv*(jbdeb-1)), npiv, 1)
149 in = inode
150 270 in = fils(in)
151 IF (in .GT. 0) GOTO 270
152 IF (in .EQ. 0) THEN
153 myleaf_left = myleaf_left - 1
154 allow_others_to_leave = ( myleaf_left .EQ. 0 .AND.
155 & keep(31) .EQ. 0)
156 IF (keep(31) .NE. 0) THEN
157 IF ( .NOT. mumps_in_or_root_ssarbr(
158 & procnode_steps(step(inode)), keep(199) ) ) THEN
159 keep(31) = keep(31) - 1
160 IF (keep(31) .EQ. 1) THEN
161 allow_others_to_leave = .true.
162 ENDIF
163 ENDIF
164 ENDIF
165 IF (allow_others_to_leave) THEN
166 do_mcast2_termbwd = .true.
167 nbfinf = nbfinf - 1
168 ENDIF
169 RETURN
170 ENDIF
171 IF = -in
172 long = npiv
173 nbfils = ne_steps(step(inode))
174 IF ( prun_below ) THEN
175 i = nbfils
176 nbfils = 0
177 DO WHILE (i.GT.0)
178 IF ( to_process(step(if)) ) nbfils = nbfils+1
179 IF = frere(step(if))
180 i = i -1
181 ENDDO
182 IF (nbfils.EQ.0) THEN
183 no_children = .true.
184 ELSE
185 no_children = .false.
186 ENDIF
187 IF = -in
188 ENDIF
189 DO i = 0, slavef - 1
190 deja_send( i ) = .false.
191 END DO
192 pool_first_pos=iipool
193 DO i = 1, nbfils
194 IF ( prun_below ) THEN
195 1030 IF ( .NOT.to_process(step(if)) ) THEN
196 IF = frere(step(if))
197 GOTO 1030
198 ENDIF
199 no_children = .false.
200 ENDIF
201 IF (mumps_procnode(procnode_steps(step(if)),keep(199))
202 & .EQ. myid) THEN
203 ipool(iipool) = IF
204 iipool = iipool + 1
205 ELSE
206 procdest = mumps_procnode(procnode_steps(step(if)),
207 & keep(199))
208 IF (.NOT. deja_send( procdest )) THEN
209 600 CONTINUE
210 CALL cmumps_buf_send_vcb( nrhs_b, IF, 0, 0,
211 & long, long, iw( j1 ),
212 & rhs_root( 1+npiv*(jbdeb-1) ),
213 & jbdeb, jbfin,
214 & rhscomp(1, 1), nrhs, lrhscomp,
215 & iposinrhscomp, npiv,
216 & keep, procdest,
217 & noeud, comm, ierr )
218 IF ( ierr .EQ. -1 ) THEN
219 CALL cmumps_backslv_recv_and_treat(
220 & .false., flag,
221 & bufr, lbufr, lbufr_bytes,
222 & myid, slavef, comm,
223 & n, iwcb, liww, posiwcb,
224 & w, lwc, poswcb,
225 & iipool, nbfinf, ptricb, ptracb, info,
226 & ipool, lpool, panel_pos, lpanel_pos,
227 & step, frere, fils, procnode_steps,
228 & pleftw, keep,keep8, dkeep,
229 & ptrist, ptrfac, iw, liw, a, la, w2,
230 & myleaf_left,
231 & nrhs, mtype,
232 & rhscomp, lrhscomp, posinrhscomp_bwd,
233 & prun_below, to_process, size_to_process
234 & , from_pp
235 & )
236 IF ( info( 1 ) .LT. 0 ) THEN
237 error_was_broadcasted = .true.
238 RETURN
239 ENDIF
240 GOTO 600
241 ELSE IF ( ierr .EQ. -2 ) THEN
242 info( 1 ) = -17
243 info( 2 ) = nrhs_b * long * keep(35) +
244 & ( long + 4 ) * keep(34)
245 error_was_broadcasted = .false.
246 RETURN
247 ELSE IF ( ierr .EQ. -3 ) THEN
248 info( 1 ) = -20
249 info( 2 ) = nrhs_b * long * keep(35) +
250 & ( long + 4 ) * keep(34)
251 error_was_broadcasted = .false.
252 RETURN
253 ELSE IF ( ierr .NE. 0 ) THEN
254 WRITE(*,*) "Internal error 2 CMUMPS_SOLVE_NODE_BWD",
255 & ierr
256 CALL mumps_abort()
257 END IF
258 deja_send( procdest ) = .true.
259 END IF
260 ENDIF
261 IF = frere(step(if))
262 ENDDO
263 allow_others_to_leave = .false.
264 IF ( prun_below .AND. no_children ) THEN
265 myleaf_left = myleaf_left - 1
266 allow_others_to_leave = ( myleaf_left .EQ. 0 .AND.
267 & keep(31) .EQ. 0)
268 ENDIF
269 IF ( keep(31). ne. 0) THEN
270 IF ( .NOT. mumps_in_or_root_ssarbr(
271 & procnode_steps(step(inode)), keep(199) ) ) THEN
272 keep(31) = keep(31) - 1
273 IF (keep(31) .EQ. 1) THEN
274 allow_others_to_leave = .true.
275 ENDIF
276 ENDIF
277 ENDIF
278 IF ( allow_others_to_leave ) THEN
279 do_mcast2_termbwd = .true.
280 nbfinf = nbfinf - 1
281 ENDIF
282 IF (iipool.NE.pool_first_pos) THEN
283 DO i=1,(iipool-pool_first_pos)/2
284 tmp = ipool(pool_first_pos+i-1)
285 ipool(pool_first_pos+i-1) = ipool(iipool-i)
286 ipool(iipool-i) = tmp
287 ENDDO
288 ENDIF
289 RETURN
290 END IF
291 in_subtree = mumps_in_or_root_ssarbr(
292 & procnode_steps(step(inode)), keep(199) )
293 typenode = mumps_typenode(procnode_steps(step(inode)),
294 & keep(199))
295 ltlevel2= (
296 & (typenode .eq.2 ) .AND.
297 & (mtype.NE.1) )
298 npiv = iw(ptrist(step(inode))+2+keep(ixsz)+1)
299 IF ((npiv.NE.0).AND.(ltlevel2)) THEN
300 ipos = ptrist(step(inode)) + 2 + keep(ixsz)
301 liell = iw(ipos-2)+iw(ipos+1)
302 nelim = iw(ipos-1)
303 ipos = ipos + 1
304 npiv = iw(ipos)
305 ncb = liell - npiv - nelim
306 ipos = ipos + 2
307 nslaves = iw( ipos )
308 offset = 0
309 ipos = ipos + nslaves
310 iw(ptrist(step(inode))+xxs)= c_fini+nslaves
311 IF ( posiwcb - 2 .LT. 0 .or.
312 & poswcb-int(ncb,8)*int(nrhs_b,8) .LT. pleftw-1_8 ) THEN
313 CALL cmumps_compso( n, keep(28), iwcb, liww, w, lwc,
314 & poswcb, posiwcb, ptricb, ptracb)
315 IF ( poswcb-int(ncb,8)*int(nrhs_b,8) .LT. pleftw-1_8 ) THEN
316 info( 1 ) = -11
317 CALL mumps_set_ierror(ncb * nrhs_b - poswcb-pleftw+1_8,
318 & info(2))
319 error_was_broadcasted = .false.
320 RETURN
321 END IF
322 IF ( posiwcb - 2 .LT. 0 ) THEN
323 info( 1 ) = -14
324 info( 2 ) = 2 - posiwcb
325 error_was_broadcasted = .false.
326 RETURN
327 END IF
328 END IF
329 posiwcb = posiwcb - 2
330 poswcb = poswcb - int(ncb,8)*int(nrhs_b,8)
331 ptricb(step( inode )) = posiwcb + 1
332 ptracb(step( inode )) = poswcb + 1_8
333 iwcb( ptricb(step( inode )) ) = ncb*nrhs_b
334 iwcb( ptricb(step( inode )) + 1 ) = 1
335 IF ( mtype.EQ.1 .AND. keep(50).EQ.0 ) THEN
336 posindices = ipos + liell + 1
337 ELSE
338 posindices = ipos + 1
339 END IF
340 IF ( ncb.EQ.0 ) THEN
341 write(6,*) ' Internal Error type 2 node with no CB '
342 CALL mumps_abort()
343 ENDIF
344 IF ( mtype .EQ. 1 .AND. keep(50).EQ.0 ) THEN
345 j1 = ipos + liell + npiv + nelim +1
346 j2 = ipos + 2 * liell
347 ELSE
348 j1 = ipos + npiv + nelim +1
349 j2 = ipos + liell
350 END IF
351 ifr8 = ptracb(step( inode )) - 1_8
352 CALL cmumps_sol_bwd_gthr( jbdeb, jbfin, j1, j2,
353 & rhscomp, nrhs, lrhscomp,
354 & w(ptracb(step(inode))), ncb, 1,
355 & iw, liw, keep, n, posinrhscomp_bwd )
356 ifr8 = ifr8 + int(j2-keep(253)-j1+1,8)
357 IF (keep(252).NE.0) THEN
358 DO jj = j2-keep(253)+1, j2
359 ifr8 = ifr8 + 1_8
360 DO k=jbdeb, jbfin
361 IF (k.EQ.jj-j2+keep(253)) THEN
362 w(ifr8+int(k-jbdeb,8)*int(ncb,8)) = alpha
363 ELSE
364 w(ifr8+int(k-jbdeb,8)*int(ncb,8)) = zero
365 ENDIF
366 ENDDO
367 ENDDO
368 ENDIF
369 DO islave = 1, nslaves
370 CALL mumps_bloc2_get_slave_info(
371 & keep,keep8, inode, step, n, slavef,
372 & istep_to_iniv2, tab_pos_in_pere,
373 & islave, ncb,
374 & nslaves,
375 & effectivesize,
376 & firstindex )
377 500 CONTINUE
378 dest = iw( ptrist(step(inode))+5+islave+keep(ixsz))
379 CALL cmumps_buf_send_backvec(nrhs_b, inode,
380 & w(offset+ptracb(step(inode))),
381 & effectivesize,
382 & ncb, dest,
383 & backslv_master2slave, jbdeb, jbfin,
384 & keep, comm, ierr )
385 IF ( ierr .EQ. -1 ) THEN
386 CALL cmumps_backslv_recv_and_treat(
387 & .false., flag,
388 & bufr, lbufr, lbufr_bytes,
389 & myid, slavef, comm,
390 & n, iwcb, liww, posiwcb,
391 & w, lwc, poswcb,
392 & iipool, nbfinf, ptricb, ptracb, info,
393 & ipool, lpool, panel_pos, lpanel_pos,
394 & step, frere, fils,
395 & procnode_steps, pleftw, keep,keep8, dkeep,
396 & ptrist, ptrfac, iw, liw, a, la, w2, myleaf_left,
397 & nrhs, mtype,
398 & rhscomp, lrhscomp, posinrhscomp_bwd,
399 & prun_below , to_process, size_to_process
400 & , from_pp
401 & )
402 IF ( info( 1 ) .LT. 0 ) THEN
403 error_was_broadcasted = .true.
404 RETURN
405 ENDIF
406 GOTO 500
407 ELSE IF ( ierr .EQ. -2 ) THEN
408 info( 1 ) = -17
409 info( 2 ) = nrhs_b * effectivesize * keep(35) +
410 & 2 * keep(34)
411 error_was_broadcasted = .false.
412 RETURN
413 ELSE IF ( ierr .EQ. -3 ) THEN
414 info( 1 ) = -20
415 info( 2 ) = nrhs_b * effectivesize * keep(35) +
416 & 2 * keep(34)
417 error_was_broadcasted = .false.
418 RETURN
419 END IF
420 offset = offset + effectivesize
421 END DO
422 iwcb( ptricb(step( inode )) + 1 ) = 0
423 CALL cmumps_freetopso(n, keep(28), iwcb, liww, w, lwc,
424 & poswcb,posiwcb,ptricb,ptracb)
425 RETURN
426 ENDIF
427 lr_activated = (iw(ptrist(step(inode))+xxlr).GT.0)
428 compress_panel = (iw(ptrist(step(inode))+xxlr).GE.2)
429 oocwrite_compatible_with_blr =
430 & (.NOT.lr_activated.OR.(.NOT.compress_panel).OR.
431 & (keep(485).EQ.0)
432 & )
433 ipos = ptrist(step(inode)) + 2 + keep(ixsz)
434 liell = iw(ipos-2)+iw(ipos+1)
435 nelim = iw(ipos-1)
436 ipos = ipos + 1
437 npiv = iw(ipos)
438 ncb = liell - npiv
439 ipos = ipos + 1
440 IF (keep(201).GT.0.AND.oocwrite_compatible_with_blr) THEN
441 CALL cmumps_solve_get_ooc_node(
442 & inode,ptrfac,keep,a,la,step,
443 & keep8,n,must_be_permuted,ierr)
444 IF(ierr.LT.0)THEN
445 info(1)=ierr
446 info(2)=0
447 error_was_broadcasted = .false.
448 RETURN
449 ENDIF
450 ENDIF
451 apos = ptrfac( step(inode))
452 nslaves = iw( ptrist(step(inode)) + 5 + keep(ixsz) )
453 ipos = ipos + 1 + nslaves
454 IF (keep(201).EQ.1.AND.oocwrite_compatible_with_blr) THEN
455 liwfac = iw(ptrist(step(inode))+xxi)
456 IF (mtype.NE.1) THEN
457 typef = typef_l
458 ELSE
459 typef = typef_u
460 ENDIF
461 panel_size = cmumps_ooc_panel_size( liell )
462 IF (keep(50).NE.1) THEN
463 CALL cmumps_ooc_pp_check_perm_freed(
464 & iw(ipos+1+2*liell),
465 & must_be_permuted )
466 ENDIF
467 ENDIF
468 long = 0
469 IF ( mtype .EQ. 1 .AND. keep(50).EQ.0 ) THEN
470 j1 = ipos + liell + 1
471 j2 = ipos + npiv + liell
472 ELSE
473 j1 = ipos + 1
474 j2 = ipos + npiv
475 ENDIF
476 IF (in_subtree) THEN
477 ptwcb = pleftw
478 IF ( poswcb .LT. int(liell,8)*int(nrhs_b,8) ) THEN
479 CALL cmumps_compso( n, keep(28), iwcb, liww, w, lwc,
480 & poswcb, posiwcb, ptricb, ptracb)
481 IF ( poswcb .LT. int(liell,8)*int(nrhs_b,8) ) THEN
482 info(1) = -11
483 CALL mumps_set_ierror(int(liell,8)*int(nrhs_b,8)-poswcb,
484 & info(2))
485 error_was_broadcasted = .false.
486 RETURN
487 END IF
488 END IF
489 ELSE
490 IF ( posiwcb - 2 .LT. 0 .or.
491 & poswcb-int(liell,8)*int(nrhs_b,8) .LT. pleftw-1_8 ) THEN
492 CALL cmumps_compso( n, keep(28), iwcb, liww, w, lwc,
493 & poswcb, posiwcb, ptricb, ptracb )
494 IF ( poswcb-int(liell,8)*int(nrhs_b,8) .LT. pleftw-1_8 ) THEN
495 info( 1 ) = -11
496 CALL mumps_set_ierror( int(liell,8)*int(nrhs_b,8)-
497 & poswcb-pleftw+1_8,
498 & info(2) )
499 error_was_broadcasted = .false.
500 RETURN
501 END IF
502 IF ( posiwcb - 2 .LT. 0 ) THEN
503 info( 1 ) = -14
504 info( 2 ) = 2 - posiwcb
505 error_was_broadcasted = .false.
506 RETURN
507 END IF
508 END IF
509 posiwcb = posiwcb - 2
510 poswcb = poswcb - int(liell,8)*int(nrhs_b,8)
511 ptricb(step( inode )) = posiwcb + 1
512 ptracb(step( inode )) = poswcb + 1_8
513 iwcb( ptricb(step( inode )) ) = liell*nrhs_b
514 iwcb( ptricb(step( inode )) + 1 ) = 1
515 IF ( mtype.EQ.1 .AND. keep(50).EQ.0 ) THEN
516 posindices = ipos + liell + 1
517 ELSE
518 posindices = ipos + 1
519 END IF
520 ptwcb = ptracb(step( inode ))
521 ENDIF
522 IF (j2.GE.j1) THEN
523 iposinrhscomp = posinrhscomp_bwd(iw(j1))
524 ELSE
525 iposinrhscomp = -99999
526 ENDIF
527 IF (j2.GE.j1) THEN
528 DO k=jbdeb, jbfin
529 IF (keep(252).NE.0) THEN
530 DO jj = j1, j2
531 rhscomp(iposinrhscomp+jj-j1,k) = zero
532 ENDDO
533 ENDIF
534 END DO
535 ENDIF
536 ifr8 = ptwcb + int(npiv - 1,8)
537 IF ( liell .GT. npiv ) THEN
538 IF ( mtype .EQ. 1 .AND. keep(50).EQ.0 ) THEN
539 j1 = ipos + liell + npiv + 1
540 j2 = ipos + 2 * liell
541 ELSE
542 j1 = ipos + npiv + 1
543 j2 = ipos + liell
544 END IF
545 CALL cmumps_sol_bwd_gthr( jbdeb, jbfin, j1, j2,
546 & rhscomp, nrhs, lrhscomp,
547 & w(ptwcb), liell, npiv+1,
548 & iw, liw, keep, n, posinrhscomp_bwd )
549 ifr8 = ifr8 + int(j2-keep(253)-j1+1,8)
550 IF (keep(252).NE.0) THEN
551 DO jj = j2-keep(253)+1, j2
552 ifr8 = ifr8 + 1_8
553 DO k=jbdeb, jbfin
554 IF (k.EQ.jj-j2+keep(253)) THEN
555 w(ifr8+int(k-jbdeb,8)*int(liell,8)) = alpha
556 ELSE
557 w(ifr8+int(k-jbdeb,8)*int(liell,8)) = zero
558 ENDIF
559 ENDDO
560 ENDDO
561 ENDIF
562 ncb = liell - npiv
563 IF (npiv .EQ. 0) GOTO 160
564 ENDIF
565 IF (keep(201).EQ.1.AND.oocwrite_compatible_with_blr) THEN
566 j = npiv / panel_size
567 twobytwo = keep(50).EQ.2 .AND.
568 & ((typenode.EQ.1.AND.keep(103).GT.0) .OR.
569 & (typenode.EQ.2.AND.keep(105).GT.0))
570 IF (twobytwo) THEN
571 CALL cmumps_build_panel_pos(panel_size, panel_pos, lpanel_pos,
572 & iw(ipos+1+liell), npiv, npanels, liell,
573 & nbentries_allpanels)
574 ELSE
575 IF (npiv.EQ.j*panel_size) THEN
576 npiv_last = npiv
577 nbjlast = panel_size
578 npanels = j
579 ELSE
580 npiv_last = (j+1)* panel_size
581 nbjlast = npiv-j*panel_size
582 npanels = j+1
583 ENDIF
584 nbentries_allpanels =
585 & int(liell,8) * int(npiv,8)
586 & - int( ( j * ( j - 1 ) ) /2,8 )
587 & * int(panel_size,8) * int(panel_size,8)
588 & - int(j,8)
589 & * int(mod(npiv, panel_size),8)
590 & * int(panel_size,8)
591 jj=npiv_last
592 ENDIF
593 aposdeb = apos + nbentries_allpanels
594 DO ipanel = npanels, 1, -1
595 IF (twobytwo) THEN
596 nbj = panel_pos(ipanel+1)-panel_pos(ipanel)
597 beg_panel = panel_pos(ipanel)
598 ELSE
599 IF (jj.EQ.npiv_last) THEN
600 nbj = nbjlast
601 ELSE
602 nbj = panel_size
603 ENDIF
604 beg_panel = jj- panel_size+1
605 ENDIF
606 ldaj = liell-beg_panel+1
607 aposdeb = aposdeb - int(nbj,8)*int(ldaj,8)
608 ptwcb_panel = ptwcb + int(beg_panel - 1,8)
609 iposinrhscomp_panel = iposinrhscomp + beg_panel - 1
610 ncb_panel = ldaj - nbj
611 IF (keep(50).NE.1.AND.must_be_permuted) THEN
612 CALL cmumps_get_ooc_perm_ptr(typef, tmp_nbpanels,
613 & i_pivrptr, i_pivr, ipos + 1 + 2 * liell, iw, liw)
614 IF (npiv.EQ.(iw(i_pivrptr)-1)) THEN
615 must_be_permuted=.false.
616 ELSE
617 CALL cmumps_permute_panel(
618 & iw(i_pivr + iw(i_pivrptr+ipanel-1)-iw(i_pivrptr)),
619 & npiv-iw(i_pivrptr+ipanel-1)+1,
620 & iw(i_pivrptr+ipanel-1)-1,
621 & a(aposdeb),
622 & ldaj, nbj, beg_panel-1)
623 ENDIF
624 ENDIF
625#if defined(MUMPS_USE_BLAS2)
626 IF ( nrhs_b == 1 ) THEN
627 IF (ncb_panel.NE.0) THEN
628 IF (ncb_panel - ncb.NE. 0) THEN
629 CALL cgemv( 'T', ncb_panel-ncb, nbj, alpha,
630 & a( aposdeb + int(nbj,8) ), ldaj,
631 & rhscomp(iposinrhscomp_panel+nbj,jbdeb),
632 & 1, one,
633 & rhscomp(iposinrhscomp_panel,jbdeb), 1 )
634 ENDIF
635 IF (ncb .NE. 0) THEN
636 CALL cgemv( 'T', ncb, nbj, alpha,
637 & a( aposdeb + int(ldaj-ncb,8) ), ldaj,
638 & w( ptwcb + int(npiv,8) ),
639 & 1, one,
640 & rhscomp(iposinrhscomp_panel,jbdeb), 1 )
641 ENDIF
642 ENDIF
643 IF (mtype.NE.1) THEN
644 CALL ctrsv('L','T','U', nbj, a(aposdeb), ldaj,
645 & rhscomp(iposinrhscomp_panel,jbdeb), 1)
646 ELSE
647 CALL ctrsv('L','T','N', nbj, a(aposdeb), ldaj,
648 & rhscomp(iposinrhscomp_panel,jbdeb), 1)
649 ENDIF
650 ELSE
651#endif
652 IF (ncb_panel.NE.0) THEN
653 IF (ncb_panel - ncb .NE. 0) THEN
654 CALL cgemm( 'T', 'N', nbj, nrhs_b,
655 & ncb_panel-ncb, alpha,
656 & a(aposdeb +int(nbj,8)), ldaj,
657 & rhscomp(iposinrhscomp_panel+nbj,jbdeb), lrhscomp,
658 & one, rhscomp(iposinrhscomp_panel,jbdeb), lrhscomp)
659 ENDIF
660 IF (ncb .NE. 0) THEN
661 CALL cgemm( 'T', 'N', nbj, nrhs_b, ncb, alpha,
662 & a(aposdeb +int(ldaj-ncb,8)), ldaj,
663 & w( ptwcb+int(npiv,8) ), liell,
664 & one, rhscomp(iposinrhscomp_panel,jbdeb),lrhscomp)
665 ENDIF
666 ENDIF
667 IF (mtype.NE.1) THEN
668 CALL ctrsm('L','L','T','U',nbj, nrhs_b, one,
669 & a(aposdeb),
670 & ldaj, rhscomp(iposinrhscomp_panel,jbdeb), lrhscomp)
671 ELSE
672 CALL ctrsm('L','L','T','N',nbj, nrhs_b, one,
673 & a(aposdeb),
674 & ldaj, rhscomp(iposinrhscomp_panel,jbdeb), lrhscomp)
675 ENDIF
676#if defined(MUMPS_USE_BLAS2)
677 ENDIF
678#endif
679 IF (.NOT. twobytwo) jj=beg_panel-1
680 ENDDO
681 ELSE
682 IF ( iw(ptrist(step(inode))+xxlr) .GE. 2
683 & .AND. keep(485) .EQ. 1 ) THEN
684 iwhdlr = iw(ptrist(step(inode))+xxf)
685 CALL cmumps_sol_bwd_lr_su (
686 & inode, iwhdlr, npiv, nslaves,
687 & liell, w, lwc, nrhs_b, ptwcb,
688 & rhscomp, lrhscomp, nrhs,
689 & iposinrhscomp, jbdeb,
690 & mtype, keep, keep8,
691 & info(1), info(2) )
692 IF (info(1).LT.0) THEN
693 error_was_broadcasted = .false.
694 RETURN
695 ENDIF
696 ELSE
697 IF ( liell .GT. npiv ) THEN
698#if defined(LDLTPANEL_DEBUG)
699 WRITE(*,*) 'before gemm LIELL, NPIV, PTWCB=',liell,npiv,ptwcb
700 WRITE(*,*) 'before gemm RHSCOMP=',
701 & rhscomp(iposinrhscomp:iposinrhscomp+npiv-1,1)
702 WRITE(*,*) 'before gemm W',
703 & w(ptwcb+npiv:ptwcb+liell-1)
704 CALL mumps_geti8(ist, iw(ptrist(step(inode))+xxr))
705 WRITE(*,*) "FACTORS=",a(apos:apos+ist-1)
706#endif
707 IF ( mtype .eq. 1 ) THEN
708 ist = apos + int(npiv,8)
709#if defined(MUMPS_USE_BLAS2)
710 IF (nrhs_b == 1) THEN
711 CALL cgemv( 'T', ncb, npiv, alpha, a(ist), liell,
712 & w(ptwcb+int(npiv,8)), 1,
713 & one,
714 & rhscomp(iposinrhscomp,jbdeb), 1 )
715 ELSE
716#endif
717 CALL cgemm('T','N', npiv, nrhs_b, ncb, alpha,
718 & a(ist),
719 & liell, w(ptwcb+int(npiv,8)), liell, one,
720 & rhscomp(iposinrhscomp,jbdeb), lrhscomp)
721#if defined(MUMPS_USE_BLAS2)
722 ENDIF
723#endif
724 ELSE
725 IF ( keep(50) .eq. 0 ) THEN
726 ist = apos + int(npiv,8) * int(liell,8)
727 ELSE
728 IF( keep(459) .GT. 1) THEN
729 CALL mumps_geti8(ist, iw(ptrist(step(inode))+xxr))
730 ist = apos + ist - int(npiv,8) * int(liell-npiv,8)
731 ELSE
732 ist = apos + int(npiv,8) * int(npiv,8)
733 ENDIF
734 END IF
735#if defined(MUMPS_USE_BLAS2)
736 IF ( nrhs_b == 1 ) THEN
737 CALL cgemv( 'N', npiv, ncb, alpha, a( ist ), npiv,
738 & w( ptwcb + int(npiv,8) ),
739 & 1, one,
740 & rhscomp(iposinrhscomp,jbdeb), 1 )
741 ELSE
742#endif
743 CALL cgemm( 'N', 'N', npiv, nrhs_b, ncb, alpha,
744 & a(ist),
745 & npiv, w(ptwcb+int(npiv,8)), liell,
746 & one, rhscomp(iposinrhscomp,jbdeb), lrhscomp)
747#if defined(MUMPS_USE_BLAS2)
748 END IF
749#endif
750 END IF
751 ENDIF
752 IF ( mtype .eq. 1 ) THEN
753 ldaj = liell
754 ELSE
755 IF ( keep(50) .EQ. 0 ) THEN
756 ldaj=liell
757 ELSE
758 IF (keep(459).GT.1) THEN
759 ldaj=-999799
760 ELSE
761 ldaj=npiv
762 ENDIF
763 ENDIF
764 END IF
765 ppiv_courant = int(jbdeb-1,8)*int(lrhscomp,8)
766 & + int(iposinrhscomp,8)
767 IF (keep(459).GT.1 .AND. keep(50).NE.0) THEN
768 CALL cmumps_solve_bwd_panels( a, la, apos,
769 & npiv, iw(ipos+1+liell),
770 & nrhs_b, rhscomp(1,1), keep8(25), lrhscomp, ppiv_courant,
771 & mtype, keep )
772 ELSE
773 CALL cmumps_solve_bwd_trsolve( a, la, apos,
774 & npiv, ldaj,
775 & nrhs_b, rhscomp(1,1), keep8(25), lrhscomp, ppiv_courant,
776 & mtype, keep )
777 ENDIF
778 ENDIF
779 ENDIF
780 IF ( mtype .EQ. 1 .AND. keep(50).EQ.0) THEN
781 j1 = ipos + liell + 1
782 ELSE
783 j1 = ipos + 1
784 END IF
785 iposinrhscomp = posinrhscomp_bwd(iw(j1))
786 160 CONTINUE
787 IF (keep(201).GT.0.AND.oocwrite_compatible_with_blr) THEN
788 CALL cmumps_free_factors_for_solve(inode,ptrfac,keep(28),
789 & a,la,.true.,ierr)
790 IF(ierr.LT.0)THEN
791 info(1)=ierr
792 info(2)=0
793 error_was_broadcasted = .false.
794 RETURN
795 ENDIF
796 ENDIF
797 in = inode
798 170 in = fils(in)
799 IF (in .GT. 0) GOTO 170
800 IF (in .EQ. 0) THEN
801 myleaf_left = myleaf_left - 1
802 IF (.NOT. in_subtree ) THEN
803 iwcb(ptricb(step(inode))+1) = iwcb(ptricb(step(inode))+1)-1
804 CALL cmumps_freetopso(n, keep(28), iwcb, liww,
805 & w, lwc,
806 & poswcb,posiwcb,ptricb,ptracb)
807 ENDIF
808 allow_others_to_leave = ( myleaf_left .EQ. 0 .AND.
809 & keep(31) .EQ. 0)
810 IF ( keep(31) .NE. 0 .AND.
811 & .NOT. in_subtree ) THEN
812 keep(31) = keep(31) - 1
813 IF (keep(31).EQ. 1) THEN
814 allow_others_to_leave = .true.
815 ENDIF
816 ENDIF
817 IF (allow_others_to_leave) THEN
818 do_mcast2_termbwd = .true.
819 nbfinf = nbfinf - 1
820 ENDIF
821 RETURN
822 ENDIF
823 IF = -in
824 nbfils = ne_steps(step(inode))
825 IF ( prun_below ) THEN
826 i = nbfils
827 nbfils = 0
828 DO WHILE (i.GT.0)
829 IF ( to_process(step(if)) ) nbfils = nbfils+1
830 IF = frere(step(if))
831 i = i -1
832 ENDDO
833 IF (nbfils.EQ.0) THEN
834 no_children = .true.
835 ELSE
836 no_children = .false.
837 ENDIF
838 IF = -in
839 ENDIF
840 IF (in_subtree) THEN
841 DO i = 1, nbfils
842 IF ( prun_below ) THEN
843 1010 CONTINUE
844 IF ( .NOT.to_process(step(if)) ) THEN
845 IF = frere(step(if))
846 GOTO 1010
847 ENDIF
848 no_children = .false.
849 ENDIF
850 ipool((iipool-i+1)+nbfils-i) = IF
851 iipool = iipool + 1
852 IF = frere(step(if))
853 ENDDO
854 IF (prun_below .AND. no_children) THEN
855 myleaf_left = myleaf_left - 1
856 allow_others_to_leave = ( myleaf_left .EQ. 0 .AND.
857 & keep(31) .EQ. 0)
858 IF (allow_others_to_leave ) THEN
859 do_mcast2_termbwd = .true.
860 nbfinf = nbfinf - 1
861 RETURN
862 ENDIF
863 ENDIF
864 ELSE
865 DO i = 0, slavef - 1
866 deja_send( i ) = .false.
867 END DO
868 pool_first_pos=iipool
869 DO 190 i = 1, nbfils
870 IF ( prun_below ) THEN
8711020 IF ( .NOT.to_process(step(if)) ) THEN
872 IF = frere(step(if))
873 GOTO 1020
874 ENDIF
875 no_children = .false.
876 ENDIF
877 IF (mumps_procnode(procnode_steps(step(if)),
878 & keep(199)) .EQ. myid) THEN
879 ipool(iipool) = IF
880 iipool = iipool + 1
881 IF = frere(step(if))
882 ELSE
883 procdest = mumps_procnode(procnode_steps(step(if)),
884 & keep(199))
885 IF (.not. deja_send( procdest )) THEN
886 400 CONTINUE
887 CALL cmumps_buf_send_vcb( nrhs_b, IF, 0, 0,
888 & liell, liell - keep(253),
889 & iw( posindices ),
890 & w( ptracb(step(inode)) ), jbdeb, jbfin,
891 & rhscomp(1, 1), nrhs, lrhscomp,
892 & iposinrhscomp, npiv,
893 & keep, procdest, noeud, comm, ierr )
894 IF ( ierr .EQ. -1 ) THEN
895 CALL cmumps_backslv_recv_and_treat(
896 & .false., flag,
897 & bufr, lbufr, lbufr_bytes,
898 & myid, slavef, comm,
899 & n, iwcb, liww, posiwcb,
900 & w, lwc, poswcb,
901 & iipool, nbfinf, ptricb, ptracb, info,
902 & ipool, lpool, panel_pos, lpanel_pos,
903 & step, frere, fils, procnode_steps,
904 & pleftw, keep, keep8, dkeep,
905 & ptrist, ptrfac, iw, liw, a, la, w2, myleaf_left,
906 & nrhs, mtype,
907 & rhscomp, lrhscomp, posinrhscomp_bwd,
908 & prun_below, to_process, size_to_process
909 & , from_pp
910 & )
911 IF ( info( 1 ) .LT. 0 ) THEN
912 error_was_broadcasted = .true.
913 RETURN
914 ENDIF
915 GOTO 400
916 ELSE IF ( ierr .EQ. -2 ) THEN
917 info( 1 ) = -17
918 info( 2 ) = nrhs_b * liell * keep(35) + 4 * keep(34)
919 error_was_broadcasted = .false.
920 RETURN
921 ELSE IF ( ierr .EQ. -3 ) THEN
922 info( 1 ) = -20
923 info( 2 ) = nrhs_b * liell * keep(35) + 4 * keep(34)
924 error_was_broadcasted = .false.
925 RETURN
926 END IF
927 deja_send( procdest ) = .true.
928 END IF
929 IF = frere(step(if))
930 ENDIF
931 190 CONTINUE
932 IF ( prun_below .AND. no_children ) THEN
933 myleaf_left = myleaf_left - 1
934 allow_others_to_leave = ( myleaf_left .EQ. 0 .AND.
935 & keep(31) .EQ. 0)
936 IF ( allow_others_to_leave ) THEN
937 do_mcast2_termbwd = .true.
938 nbfinf = nbfinf - 1
939 RETURN
940 ENDIF
941 ENDIF
942 DO i=1,(iipool-pool_first_pos)/2
943 tmp=ipool(pool_first_pos+i-1)
944 ipool(pool_first_pos+i-1)=ipool(iipool-i)
945 ipool(iipool-i)=tmp
946 ENDDO
947 IF ( keep(31) .NE. 0 )
948 & THEN
949 keep(31) = keep(31) - 1
950 allow_others_to_leave = (keep(31) .EQ. 1)
951 IF (allow_others_to_leave) THEN
952 do_mcast2_termbwd = .true.
953 nbfinf = nbfinf - 1
954 ENDIF
955 ENDIF
956 iwcb(ptricb(step(inode))+1) = iwcb(ptricb(step(inode))+1)-1
957 CALL cmumps_freetopso(n, keep(28), iwcb, liww,
958 & w, lwc,
959 & poswcb,posiwcb,ptricb,ptracb)
960 ENDIF
961 RETURN
cmumps_get_ooc_perm_ptr
subroutine cmumps_get_ooc_perm_ptr(typef, nbpanels, i_pivptr, i_piv, ipos, iw, liw)
Definition cooc_panel_piv.F:133
cmumps_ooc_pp_check_perm_freed
subroutine cmumps_ooc_pp_check_perm_freed(iw_location, must_be_permuted)
Definition cooc_panel_piv.F:349
cmumps_permute_panel
subroutine cmumps_permute_panel(ipiv, lpiv, ishift, the_panel, nbrow, nbcol, kbeforepanel)
Definition cooc_panel_piv.F:78
cmumps_compso
subroutine cmumps_compso(n, keep28, iwcb, liww, w, lwc, poswcb, iwposcb, ptricb, ptracb)
Definition csol_aux.F:37
cmumps_sol_cpy_fs2rhscomp
subroutine cmumps_sol_cpy_fs2rhscomp(jbdeb, jbfin, nbrows, keep, rhscomp, nrhs, lrhscomp, first_row_rhscomp, w, ld_w, first_row_w)
Definition csol_aux.F:1041
cmumps_sol_bwd_gthr
subroutine cmumps_sol_bwd_gthr(jbdeb, jbfin, j1, j2, rhscomp, nrhs, lrhscomp, w, ld_w, first_row_w, iw, liw, keep, n, posinrhscomp_bwd)
Definition csol_aux.F:1064
cmumps_solve_get_ooc_node
subroutine cmumps_solve_get_ooc_node(inode, ptrfac, keep, a, la, step, keep8, n, must_be_permuted, ierr)
Definition csol_aux.F:733
cmumps_build_panel_pos
subroutine cmumps_build_panel_pos(panel_size, panel_pos, len_panel_pos, indices, npiv, npanels, nfront_or_nass, nbentries_allpanels)
Definition csol_bwd_aux.F:1848
if
if(complex_arithmetic) id
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
cmumps_buf::cmumps_buf_send_backvec
subroutine, public cmumps_buf_send_backvec(nrhs, inode, w, lw, ld_w, dest, msgtag, jbdeb, jbfin, keep, comm, ierr)
Definition cmumps_comm_buffer.F:2627
cmumps_ooc::cmumps_ooc_panel_size
integer function, public cmumps_ooc_panel_size(nnmax)
Definition cmumps_ooc.F:3404
mumps_typenode
integer function mumps_typenode(procinfo_inode, k199)
Definition tools_common.F:90
mumps_set_ierror
subroutine mumps_set_ierror(size8, ierror)
Definition tools_common.F:865