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 ZMUMPS_PROCESS_DESC_BANDE( MYID, BUFR, LBUFR, 14 & LBUFR_BYTES, 15 & IWPOS, IWPOSCB, 16 & IPTRLU, LRLU, LRLUS, 17 & TNBPROCFILS, N, IW, LIW, A, LA, 18 & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, COMP, 19 & KEEP,KEEP8, DKEEP, ITLOC, RHS_MUMPS, ISTEP_TO_INIV2, 20#if ! defined(NO_FDM_DESCBAND) 21 & IWHANDLER_IN, 22#endif 23 & IFLAG, IERROR ) 24 USE ZMUMPS_LOAD 25#if ! defined(NO_FDM_DESCBAND) 26 USE MUMPS_FAC_DESCBAND_DATA_M 27#endif 28 IMPLICIT NONE 29 INTEGER MYID 30 INTEGER KEEP(500) 31 INTEGER(8) KEEP8(150) 32 DOUBLE PRECISION DKEEP(230) 33 INTEGER LBUFR, LBUFR_BYTES 34 INTEGER BUFR( LBUFR ) 35 INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA 36 INTEGER IWPOS, IWPOSCB, N, LIW 37 INTEGER IW( LIW ) 38 COMPLEX(kind=8) A( LA ) 39 INTEGER(8) :: PAMASTER(KEEP(28)) 40 INTEGER(8) :: PTRAST(KEEP(28)) 41 INTEGER PTRIST(KEEP(28)), STEP(N), 42 & PIMASTER(KEEP(28)), 43 & TNBPROCFILS( KEEP(28) ), ITLOC( N + KEEP(253) ) 44 COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) 45 INTEGER :: ISTEP_TO_INIV2(KEEP(71)) 46#if ! defined(NO_FDM_DESCBAND) 47 INTEGER IWHANDLER_IN 48#endif 49 INTEGER COMP, IFLAG, IERROR 50 INTEGER INODE, NBPROCFILS, NCOL, NROW, NASS, NSLAVES 51 INTEGER NSLAVES_RECU, NFRONT 52 INTEGER LREQ 53 INTEGER :: IBUFR 54 INTEGER(8) :: LREQCB 55#if ! defined(NO_FDM_DESCBAND) 56 INTEGER :: IWHANDLER_LOC 57#endif 58 DOUBLE PRECISION FLOP1 59 INCLUDE 'mumps_headers.h' 60#if ! defined(NO_FDM_DESCBAND) 61 INTEGER :: INFO_TMP(2) 62#else 63#endif 64 INTEGER :: LRSTATUS 65 INODE = BUFR( 2 ) 66 NBPROCFILS = BUFR( 3 ) 67 NROW = BUFR( 4 ) 68 NCOL = BUFR( 5 ) 69 NASS = BUFR( 6 ) 70 NFRONT = BUFR( 7 ) 71 NSLAVES_RECU = BUFR( 8 ) 72 LRSTATUS = BUFR( 9 ) 73 IBUFR = 10 74#if ! defined(NO_FDM_DESCBAND) 75 IWHANDLER_LOC = IWHANDLER_IN 76 IF ((IWHANDLER_IN .LE. 0) .AND. 77 & (INODE .NE. INODE_WAITED_FOR)) THEN 78 INFO_TMP=0 79 CALL MUMPS_FDBD_SAVE_DESCBAND(INODE, BUFR(1), BUFR, 80 & IWHANDLER_LOC, INFO_TMP) 81 IF (INFO_TMP(1) < 0) THEN 82 IFLAG = INFO_TMP(1) 83 IERROR = INFO_TMP(2) 84 RETURN 85 ENDIF 86 GOTO 555 87 ENDIF 88#endif 89 IF ( KEEP(50) .eq. 0 ) THEN 90 FLOP1 = dble( NASS * NROW ) + 91 & dble(NROW*NASS)*dble(2*NCOL-NASS-1) 92 ELSE 93 FLOP1 = dble( NASS ) * dble( NROW ) 94 & * dble( 2 * NCOL - NROW - NASS + 1) 95 END IF 96 CALL ZMUMPS_LOAD_UPDATE(1,.TRUE.,FLOP1, KEEP,KEEP8) 97 IF ( KEEP(50) .eq. 0 ) THEN 98 NSLAVES = NSLAVES_RECU + XTRA_SLAVES_UNSYM 99 ELSE 100 NSLAVES = NSLAVES_RECU + XTRA_SLAVES_SYM 101 END IF 102 LREQ = NROW + NCOL + 6 + NSLAVES + KEEP(IXSZ) 103 LREQCB = int(NCOL,8) * int(NROW,8) 104 CALL ZMUMPS_ALLOC_CB(.FALSE., 0_8, .FALSE.,.TRUE., 105 & MYID,N, KEEP, KEEP8, DKEEP, IW, LIW, A, LA, 106 & LRLU, IPTRLU,IWPOS,IWPOSCB, 107 & PTRIST,PTRAST, STEP, PIMASTER,PAMASTER, 108 & LREQ, LREQCB, INODE, S_ACTIVE, .TRUE., 109 & COMP, LRLUS, IFLAG, IERROR 110 & ) 111 IF ( IFLAG .LT. 0 ) RETURN 112 PTRIST(STEP(INODE)) = IWPOSCB + 1 113 PTRAST(STEP(INODE)) = IPTRLU + 1_8 114# if ! defined(NO_FDM_DESCBAND) 115 555 CONTINUE 116# endif 117# if ! defined(NO_FDM_DESCBAND) 118 IF ((IWHANDLER_IN .LE. 0) .AND. 119 & (INODE .NE. INODE_WAITED_FOR)) THEN 120 RETURN 121 ENDIF 122 IW(IWPOSCB+1+XXA) = IWHANDLER_LOC 123# endif 124 IW( IWPOSCB + 1+KEEP(IXSZ) ) = NCOL 125 IW( IWPOSCB + 2+KEEP(IXSZ) ) = - NASS 126 IW( IWPOSCB + 3+KEEP(IXSZ) ) = NROW 127 IW( IWPOSCB + 4+KEEP(IXSZ) ) = 0 128 IW( IWPOSCB + 5+KEEP(IXSZ) ) = NASS 129 IW( IWPOSCB + 6+KEEP(IXSZ) ) = NSLAVES 130 IW( IWPOSCB + 7+KEEP(IXSZ)+NSLAVES : 131 & IWPOSCB + 6+KEEP(IXSZ)+NSLAVES + NROW + NCOL ) 132 &= BUFR( IBUFR + NSLAVES_RECU : 133 & IBUFR + NSLAVES_RECU + NROW + NCOL - 1 ) 134 IF ( KEEP(50) .eq. 0 ) THEN 135 IW( IWPOSCB + 7+KEEP(IXSZ) ) = S_ROOTBAND_INIT 136 IF (NSLAVES_RECU.GT.0) THEN 137 write(6,*) " Internal error in ZMUMPS_PROCESS_DESC_BANDE " 138 CALL MUMPS_ABORT() 139 ENDIF 140 ELSE 141 IW( IWPOSCB+7+KEEP(IXSZ) ) = huge(IW(IWPOSCB+7+KEEP(IXSZ))) 142 IW( IWPOSCB + 8+KEEP(IXSZ) ) = NFRONT 143 IW( IWPOSCB + 9+KEEP(IXSZ) ) = S_ROOTBAND_INIT 144 IW( IWPOSCB + 7+XTRA_SLAVES_SYM+KEEP(IXSZ): 145 & IWPOSCB + 6+XTRA_SLAVES_SYM+KEEP(IXSZ)+NSLAVES_RECU ) = 146 & BUFR( IBUFR: IBUFR - 1 + NSLAVES_RECU ) 147 END IF 148 TNBPROCFILS(STEP( INODE )) = NBPROCFILS 149# if ! defined(NO_XXNBPR) 150 IW(IWPOSCB+1+XXNBPR)=NBPROCFILS 151# endif 152 IW(IWPOSCB+1+XXLR)=LRSTATUS 153 IF (NBPROCFILS .EQ. 0) THEN 154 ENDIF 155 RETURN 156 END SUBROUTINE ZMUMPS_PROCESS_DESC_BANDE 157 RECURSIVE SUBROUTINE ZMUMPS_TREAT_DESCBAND( INODE, 158 & COMM_LOAD, ASS_IRECV, 159 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, 160 & IWPOS, IWPOSCB, IPTRLU, 161 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 162 & PTLUST, PTRFAC, 163 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, 164 & IFLAG, IERROR, COMM, NBPROCFILS, 165 & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, 166 & 167 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, 168 & FILS, PTRARW, PTRAIW, 169 & INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE, 170 & LPTRAR, NELT, FRTPTR, FRTELT, 171 & 172 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 173 & STACK_RIGHT_AUTHORIZED 174 & , LRGROUPS 175 & ) 176# if ! defined(NO_FDM_DESCBAND) 177 USE MUMPS_FAC_DESCBAND_DATA_M 178# endif 179 IMPLICIT NONE 180 INCLUDE 'zmumps_root.h' 181 INTEGER, INTENT(IN) :: INODE 182 TYPE (ZMUMPS_ROOT_STRUC) :: root 183 INTEGER KEEP(500), ICNTL(40) 184 INTEGER(8) KEEP8(150) 185 DOUBLE PRECISION DKEEP(230) 186 INTEGER LBUFR, LBUFR_BYTES 187 INTEGER COMM_LOAD, ASS_IRECV 188 INTEGER BUFR( LBUFR ) 189 INTEGER(8) :: LA, POSFAC, IPTRLU, LRLU, LRLUS 190 INTEGER IWPOS, IWPOSCB 191 INTEGER N, LIW 192 INTEGER IW( LIW ) 193 COMPLEX(kind=8) A( LA ) 194 INTEGER, intent(in) :: LRGROUPS(N) 195 INTEGER(8) :: PTRAST(KEEP(28)) 196 INTEGER(8) :: PTRFAC(KEEP(28)) 197 INTEGER(8) :: PAMASTER(KEEP(28)) 198 INTEGER PTRIST( KEEP(28) ), 199 & PTLUST(KEEP(28)) 200 INTEGER STEP(N), 201 & PIMASTER(KEEP(28)) 202 INTEGER COMP 203 INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) ) 204 INTEGER NBPROCFILS( KEEP(28) ) 205 INTEGER IFLAG, IERROR, COMM 206 INTEGER LPOOL, LEAF 207 INTEGER IPOOL( LPOOL ) 208 INTEGER MYID, SLAVEF, NBFIN 209 DOUBLE PRECISION OPASSW, OPELIW 210 INTEGER NELT, LPTRAR 211 INTEGER FRTPTR( N+1 ), FRTELT( NELT ) 212 INTEGER ITLOC( N + KEEP(253) ), FILS( N ) 213 COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) 214 INTEGER(8), INTENT(IN) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR ) 215 INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) 216 INTEGER ISTEP_TO_INIV2(KEEP(71)), 217 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) 218 COMPLEX(kind=8) DBLARR( KEEP8(26) ) 219 INTEGER INTARR( KEEP8(27) ) 220 LOGICAL, intent(in) :: STACK_RIGHT_AUTHORIZED 221 INCLUDE 'mpif.h' 222 INCLUDE 'mumps_tags.h' 223 INCLUDE 'mumps_headers.h' 224 LOGICAL :: BLOCKING, SET_IRECV, MESSAGE_RECEIVED 225 INTEGER :: STATUS(MPI_STATUS_SIZE) 226 INTEGER :: SRC_DESCBAND 227#if ! defined(NO_FDM_DESCBAND) 228 INTEGER :: IWHANDLER 229 TYPE(DESCBAND_STRUC_T), POINTER :: DESCBAND_STRUC 230#endif 231 INTEGER MUMPS_PROCNODE 232 EXTERNAL MUMPS_PROCNODE 233 SRC_DESCBAND = MUMPS_PROCNODE( PROCNODE_STEPS(STEP(INODE)), 234 & SLAVEF ) 235# if ! defined(NO_FDM_DESCBAND) 236 IF (MUMPS_FDBD_IS_DESCBAND_STORED( INODE, IWHANDLER )) THEN 237 CALL MUMPS_FDBD_RETRIEVE_DESCBAND(IWHANDLER, DESCBAND_STRUC) 238 CALL ZMUMPS_PROCESS_DESC_BANDE( MYID, DESCBAND_STRUC%BUFR(1), 239 & DESCBAND_STRUC%LBUFR, 240 & LBUFR_BYTES, 241 & IWPOS, IWPOSCB, 242 & IPTRLU, LRLU, LRLUS, 243 & NBPROCFILS, N, IW, LIW, A, LA, 244 & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, COMP, 245 & KEEP, KEEP8, DKEEP, ITLOC, RHS_MUMPS, ISTEP_TO_INIV2, 246 & IWHANDLER, 247 & IFLAG, IERROR ) 248 IF (IFLAG .LT. 0) GOTO 500 249 CALL MUMPS_FDBD_FREE_DESCBAND_STRUC(IW(PTRIST(STEP(INODE))+XXA)) 250 ELSE 251 IF (INODE_WAITED_FOR.GT.0) THEN 252 WRITE(*,*) " Internal error 1 in ZMUMPS_TREAT_DESCBAND", 253 & INODE, INODE_WAITED_FOR 254 CALL MUMPS_ABORT() 255 ENDIF 256 INODE_WAITED_FOR = INODE 257# endif 258 DO WHILE (PTRIST(STEP(INODE)) .EQ. 0) 259 BLOCKING = .TRUE. 260 SET_IRECV = .FALSE. 261 MESSAGE_RECEIVED = .FALSE. 262 CALL ZMUMPS_TRY_RECVTREAT(COMM_LOAD, 263 & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, 264 & SRC_DESCBAND, MAITRE_DESC_BANDE, 265 & STATUS, 266 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, 267 & IWPOS, IWPOSCB, IPTRLU, 268 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, 269 & PTLUST, PTRFAC, 270 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, 271 & IFLAG, IERROR, COMM, 272 & NBPROCFILS, IPOOL, LPOOL, LEAF, 273 & NBFIN, MYID, SLAVEF, 274 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, 275 & FILS, PTRARW, PTRAIW, 276 & INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE, 277 & LPTRAR, NELT, FRTPTR, FRTELT, 278 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. 279 & , LRGROUPS 280 & ) 281 IF (IFLAG .LT. 0) THEN 282 RETURN 283 ENDIF 284 ENDDO 285# if ! defined(NO_FDM_DESCBAND) 286 INODE_WAITED_FOR = -1 287 ENDIF 288# endif 289 RETURN 290 500 CONTINUE 291 CALL ZMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP ) 292 RETURN 293 END SUBROUTINE ZMUMPS_TREAT_DESCBAND 294