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 DMUMPS_PROCESS_MASTER2(MYID,BUFR, LBUFR, 14 & LBUFR_BYTES, 15 & PROCNODE_STEPS, SLAVEF, 16 & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, 17 & N, IW, LIW, A, LA, 18 & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, 19 & COMP, 20 & IFLAG, IERROR, COMM, COMM_LOAD, 21 & IPOOL, LPOOL, LEAF, KEEP, KEEP8, DKEEP, ND, FILS, FRERE, 22 & ITLOC, RHS_MUMPS, 23 & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) 24 USE DMUMPS_LOAD 25 IMPLICIT NONE 26 INCLUDE 'mpif.h' 27 INTEGER IERR 28 INTEGER MYID 29 INTEGER KEEP(500) 30 INTEGER(8) KEEP8(150) 31 DOUBLE PRECISION DKEEP(230) 32 INTEGER LBUFR, LBUFR_BYTES 33 INTEGER BUFR( LBUFR ) 34 INTEGER SLAVEF 35 INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA 36 INTEGER IWPOS, IWPOSCB 37 INTEGER N, LIW 38 INTEGER IW( LIW ) 39 DOUBLE PRECISION A( LA ) 40 INTEGER(8) :: PTRAST(KEEP(28)) 41 INTEGER(8) :: PAMASTER(KEEP(28)) 42 INTEGER PTRIST(KEEP(28)), STEP(N), PIMASTER(KEEP(28)) 43 INTEGER PROCNODE_STEPS( KEEP(28) ), ITLOC( N +KEEP(253) ) 44 DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) 45 INTEGER COMP 46 INTEGER NSTK_S( KEEP(28) ) 47 INTEGER IFLAG, IERROR, COMM, COMM_LOAD 48 INTEGER LPOOL, LEAF 49 INTEGER IPOOL( LPOOL ) 50 INTEGER ND(KEEP(28)), FILS( N ), FRERE( KEEP(28) ) 51 INTEGER ISTEP_TO_INIV2(KEEP(71)), 52 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) 53 INTEGER POSITION, IFATH, ISON, NROW, NCOL, NELIM, 54 & NSLAVES 55 INTEGER(8) :: NOREAL 56 INTEGER NOINT, INIV2, NCOL_EFF 57 DOUBLE PRECISION FLOP1 58 INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET 59 INTEGER NOREAL_PACKET 60 LOGICAL PERETYPE2 61 INCLUDE 'mumps_headers.h' 62 INTEGER MUMPS_TYPENODE 63 EXTERNAL MUMPS_TYPENODE 64 POSITION = 0 65 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, 66 & IFATH, 1, MPI_INTEGER 67 & , COMM, IERR) 68 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, 69 & ISON , 1, MPI_INTEGER, 70 & COMM, IERR) 71 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, 72 & NSLAVES, 1, 73 & MPI_INTEGER, COMM, IERR ) 74 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, 75 & NROW , 1, MPI_INTEGER 76 & , COMM, IERR) 77 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, 78 & NCOL , 1, MPI_INTEGER 79 & , COMM, IERR) 80 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, 81 & NBROWS_ALREADY_SENT, 1, 82 & MPI_INTEGER, COMM, IERR) 83 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, 84 & NBROWS_PACKET, 1, 85 & MPI_INTEGER, COMM, IERR) 86 IF ( NSLAVES .NE. 0 .and. KEEP(50).ne.0 ) THEN 87 NCOL_EFF = NROW 88 ELSE 89 NCOL_EFF = NCOL 90 ENDIF 91 NOREAL_PACKET = NBROWS_PACKET * NCOL_EFF 92 IF (NBROWS_ALREADY_SENT .EQ. 0) THEN 93 NOINT = 6 + NROW + NCOL + NSLAVES + KEEP(IXSZ) 94 NOREAL= int(NROW,8) * int(NCOL_EFF,8) 95 CALL DMUMPS_ALLOC_CB(.FALSE.,0_8,.FALSE.,.FALSE., 96 & MYID,N,KEEP,KEEP8,DKEEP,IW,LIW,A,LA, 97 & LRLU, IPTRLU,IWPOS,IWPOSCB, 98 & PTRIST,PTRAST,STEP, PIMASTER, PAMASTER, 99 & NOINT, NOREAL, ISON, S_NOTFREE, .TRUE., 100 & COMP, LRLUS, IFLAG, IERROR 101 & ) 102 IF ( IFLAG .LT. 0 ) THEN 103 RETURN 104 ENDIF 105 PIMASTER(STEP( ISON )) = IWPOSCB + 1 106 PAMASTER(STEP( ISON )) = IPTRLU + 1_8 107 IW( IWPOSCB + 1 + XXNBPR ) = 0 108 IW( IWPOSCB + 1 + KEEP(IXSZ) ) = NCOL 109 NELIM = NROW 110 IW( IWPOSCB + 2 + KEEP(IXSZ) ) = NELIM 111 IW( IWPOSCB + 3 + KEEP(IXSZ) ) = NROW 112 IF ( NSLAVES .NE. 0 .and. KEEP(50).ne.0 ) THEN 113 IW( IWPOSCB + 4 + KEEP(IXSZ) ) = NROW - NCOL 114 IF ( NROW - NCOL .GE. 0 ) THEN 115 WRITE(*,*) 'Error in PROCESS_MAITRE2:',NROW,NCOL 116 CALL MUMPS_ABORT() 117 END IF 118 ELSE 119 IW( IWPOSCB + 4 + KEEP(IXSZ) ) = 0 120 END IF 121 IW( IWPOSCB + 5 + KEEP(IXSZ) ) = 1 122 IW( IWPOSCB + 6 + KEEP(IXSZ) ) = NSLAVES 123 IF (NSLAVES.GT.0) THEN 124 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, 125 & IW( IWPOSCB + 7 + KEEP(IXSZ) ), 126 & NSLAVES, MPI_INTEGER, COMM, IERR ) 127 ENDIF 128 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, 129 & IW(IWPOSCB + 7 + KEEP(IXSZ) + NSLAVES), 130 & NROW, MPI_INTEGER, COMM, IERR) 131 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, 132 & IW(IWPOSCB + 7 + KEEP(IXSZ) + NROW + NSLAVES), 133 & NCOL, MPI_INTEGER, COMM, IERR) 134 IF ( NSLAVES .GT. 0 ) THEN 135 INIV2 = ISTEP_TO_INIV2 ( STEP(ISON) ) 136 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, 137 & TAB_POS_IN_PERE(1,INIV2), 138 & NSLAVES+1, MPI_INTEGER, COMM, IERR) 139 TAB_POS_IN_PERE(SLAVEF+2,INIV2) = NSLAVES 140 ENDIF 141 ENDIF 142 IF (NOREAL_PACKET.GT.0) THEN 143 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, 144 & A(PAMASTER(STEP(ISON)) + 145 & int(NBROWS_ALREADY_SENT,8) * int(NCOL_EFF,8)), 146 & NOREAL_PACKET, MPI_DOUBLE_PRECISION, COMM, IERR) 147 ENDIF 148 IF ( NBROWS_ALREADY_SENT + NBROWS_PACKET .EQ. NROW ) THEN 149 PERETYPE2 = ( MUMPS_TYPENODE(PROCNODE_STEPS(STEP(IFATH)), 150 & SLAVEF) .EQ. 2 ) 151 NSTK_S( STEP(IFATH )) = NSTK_S( STEP(IFATH) ) - 1 152 IF ( NSTK_S( STEP(IFATH)) .EQ. 0 ) THEN 153 CALL DMUMPS_INSERT_POOL_N(N, IPOOL, LPOOL, PROCNODE_STEPS, 154 & SLAVEF, KEEP(28), KEEP(76), KEEP(80), KEEP(47), 155 & STEP, IFATH ) 156 IF (KEEP(47) .GE. 3) THEN 157 CALL DMUMPS_LOAD_POOL_UPD_NEW_POOL( 158 & IPOOL, LPOOL, 159 & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, 160 & MYID, STEP, N, ND, FILS ) 161 ENDIF 162 CALL MUMPS_ESTIM_FLOPS( IFATH, N, PROCNODE_STEPS, 163 & SLAVEF, ND, 164 & FILS,FRERE, STEP, PIMASTER, 165 & KEEP(28), KEEP(50), KEEP(253), 166 & FLOP1,IW, LIW, KEEP(IXSZ) ) 167 IF (IFATH.NE.KEEP(20)) 168 & CALL DMUMPS_LOAD_UPDATE(1, .FALSE., FLOP1, KEEP,KEEP8) 169 END IF 170 ENDIF 171 RETURN 172 END SUBROUTINE DMUMPS_PROCESS_MASTER2 173