1C 2C This file is part of MUMPS 5.1.2, released 3C on Mon Oct 2 07:37:01 UTC 2017 4C 5C 6C Copyright 1991-2017 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria, 7C University of Bordeaux. 8C 9C This version of MUMPS is provided to you free of charge. It is 10C released under the CeCILL-C license: 11C http://www.cecill.info/licences/Licence_CeCILL-C_V1-en.html 12C 13 SUBROUTINE CMUMPS_SOL_R(N, A, LA, IW, LIW, WCB, LWCB, 14 & NRHS, 15 & PTRICB, IWCB, LIWCB, 16 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_FWD, 17 & NE_STEPS, NA, LNA, STEP, 18 & FRERE, DAD, FILS, 19 & NSTK_S, IPOOL, LPOOL, PTRIST, PTRFAC, MYLEAF, INFO, 20 & KEEP, KEEP8, DKEEP, 21 & PROCNODE_STEPS, 22 & SLAVEF, COMM, MYID, BUFR, LBUFR, LBUFR_BYTES, 23 & RHS_ROOT, LRHS_ROOT, MTYPE, 24 & 25 & ISTEP_TO_INIV2, TAB_POS_IN_PERE 26 & , RHS_BOUNDS, LRHS_BOUNDS, DO_NBSPARSE, FROM_PP 27 & ) 28 USE CMUMPS_OOC 29 IMPLICIT NONE 30 INTEGER MTYPE 31 INTEGER(8), INTENT(IN) :: LA, LWCB 32 INTEGER, INTENT(IN) :: N, LIW, LPOOL, LIWCB, LNA 33 INTEGER SLAVEF, MYLEAF, COMM, MYID 34 INTEGER INFO( 40 ), KEEP(500) 35 INTEGER(8) KEEP8(150) 36 REAL, INTENT(INOUT) :: DKEEP(230) 37 INTEGER PROCNODE_STEPS( KEEP(28) ) 38 INTEGER NRHS 39 COMPLEX A( LA ), WCB( LWCB ) 40 INTEGER(8), intent(in) :: LRHS_ROOT 41 COMPLEX RHS_ROOT( LRHS_ROOT ) 42 INTEGER LBUFR, LBUFR_BYTES 43 INTEGER BUFR( LBUFR ) 44 INTEGER NA( LNA ), NE_STEPS( KEEP(28) ) 45 INTEGER STEP( N ), FRERE( KEEP(28) ), FILS( N ), 46 & DAD( KEEP(28) ) 47 INTEGER NSTK_S(KEEP(28)), IPOOL( LPOOL ) 48 INTEGER PTRIST(KEEP(28)) 49 INTEGER(8) :: PTRFAC(KEEP(28)) 50 INTEGER PTRICB( KEEP(28) ) 51 LOGICAL, intent(in) :: DO_NBSPARSE 52 INTEGER, intent(in) :: LRHS_BOUNDS 53 INTEGER, intent(in) :: RHS_BOUNDS(LRHS_BOUNDS) 54 INTEGER IW( LIW ), IWCB( LIWCB ) 55 INTEGER ISTEP_TO_INIV2(KEEP(71)), 56 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) 57 INTEGER, intent(in) :: POSINRHSCOMP_FWD(N), LRHSCOMP 58#if defined(RHSCOMP_BYROWS) 59 COMPLEX, intent(inout) :: RHSCOMP(NRHS,LRHSCOMP) 60#else 61 COMPLEX, intent(inout) :: RHSCOMP(LRHSCOMP,NRHS) 62#endif 63 LOGICAL, intent(in) :: FROM_PP 64 INCLUDE 'mpif.h' 65 INCLUDE 'mumps_tags.h' 66 INTEGER MSGTAG, MSGSOU, DUMMY(1) 67 LOGICAL FLAG 68 INTEGER NBFIN, MYROOT 69 INTEGER POSIWCB 70 INTEGER(8) :: POSWCB, PLEFTWCB 71 INTEGER INODE 72 INTEGER I 73 INTEGER III, NBROOT,LEAF 74 LOGICAL BLOQ 75 EXTERNAL MUMPS_PROCNODE 76 INTEGER MUMPS_PROCNODE 77 DUMMY(1) = 1 78 KEEP(266)=0 79 POSIWCB = LIWCB 80 POSWCB = LWCB 81 PLEFTWCB= 1_8 82 DO I = 1, KEEP(28) 83 NSTK_S(I) = NE_STEPS(I) 84 ENDDO 85 PTRICB = 0 86 CALL MUMPS_INIT_POOL_DIST(N, LEAF, MYID, 87 & SLAVEF, NA, LNA, KEEP,KEEP8, STEP, 88 & PROCNODE_STEPS, IPOOL, LPOOL) 89 CALL MUMPS_INIT_NROOT_DIST(N, NBROOT, MYROOT, MYID, 90 & SLAVEF, NA, LNA, KEEP, STEP, 91 & PROCNODE_STEPS) 92 NBFIN = SLAVEF 93 IF ( MYROOT .EQ. 0 ) THEN 94 NBFIN = NBFIN - 1 95 CALL CMUMPS_MCAST2(DUMMY, 1, MPI_INTEGER, MYID, COMM, 96 & RACINE_SOLVE, SLAVEF, KEEP) 97 IF (NBFIN.EQ.0) GOTO 260 98 END IF 99 MYLEAF = LEAF - 1 100 III = 1 101 50 CONTINUE 102 IF (SLAVEF .EQ. 1) THEN 103 CALL CMUMPS_GET_INODE_FROM_POOL 104 & ( IPOOL(1), LPOOL, III, LEAF, INODE, 105 & KEEP(208) ) 106 GOTO 60 107 ENDIF 108 BLOQ = ( ( III .EQ. LEAF ) 109 & ) 110 CALL CMUMPS_SOLVE_RECV_AND_TREAT( BLOQ, FLAG, 111 & BUFR, LBUFR, LBUFR_BYTES, 112 & MYID, SLAVEF, COMM, 113 & N, NRHS, IPOOL, LPOOL, III, LEAF, 114 & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC, 115 & IWCB, LIWCB, 116 & WCB, LWCB, POSWCB, 117 & PLEFTWCB, POSIWCB, 118 & PTRICB, INFO, KEEP,KEEP8, DKEEP, STEP, 119 & PROCNODE_STEPS, 120 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_FWD 121 & , FROM_PP ) 122 IF ( INFO( 1 ) .LT. 0 .OR. NBFIN .EQ. 0 ) GOTO 260 123 IF (.not. FLAG) THEN 124 IF (III .NE. LEAF) THEN 125 CALL CMUMPS_GET_INODE_FROM_POOL 126 & (IPOOL(1), LPOOL, III, LEAF, INODE, 127 & KEEP(208) ) 128 GOTO 60 129 ENDIF 130 ENDIF 131 GOTO 50 132 60 CONTINUE 133 CALL CMUMPS_SOLVE_NODE( INODE, BUFR, LBUFR, LBUFR_BYTES, 134 & MSGTAG, MSGSOU, MYID, SLAVEF, COMM, N, 135 & IPOOL, LPOOL, III, LEAF, NBFIN, NSTK_S, 136 & IWCB, LIWCB, WCB, LWCB, A, LA, 137 & IW, LIW, NRHS, 138 & POSWCB, PLEFTWCB, POSIWCB, 139 & PTRICB, PTRIST, PTRFAC, PROCNODE_STEPS, 140 & FILS, STEP, FRERE, DAD, 141 & MYROOT, INFO, KEEP,KEEP8, DKEEP, RHS_ROOT, MTYPE, 142 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_FWD, 143 & ISTEP_TO_INIV2, TAB_POS_IN_PERE 144 & , RHS_BOUNDS, LRHS_BOUNDS, DO_NBSPARSE 145 & , FROM_PP ) 146 IF ( INFO( 1 ) .LT. 0 .OR. NBFIN .EQ. 0 ) GOTO 260 147 GOTO 50 148 260 CONTINUE 149 CALL CMUMPS_CLEAN_PENDING(INFO(1), KEEP, BUFR, LBUFR,LBUFR_BYTES, 150 & COMM, DUMMY(1), 151 & SLAVEF, .TRUE., .FALSE.) 152 RETURN 153 END SUBROUTINE CMUMPS_SOL_R 154