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

Go to the source code of this file.

Functions/Subroutines

recursive subroutine dmumps_traiter_message (comm_load, ass_irecv, msgsou, msgtag, msglen, bufr, lbufr, lbufr_bytes, procnode_steps, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, nstk_s, comp, iflag, ierror, comm, perm, ipool, lpool, leaf, nbfin, myid, slavef root, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, dkeep, nd, frere, lptrar, nelt, frtptr, frtelt istep_to_iniv2, tab_pos_in_pere, lrgroups)
recursive subroutine dmumps_recv_and_treat (comm_load, ass_irecv, status, bufr, lbufr, lbufr_bytes, procnode_steps, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, nstk_s, comp, iflag, ierror, comm, perm, ipool, lpool, leaf, nbfin, myid, slavef root, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, dkeep, nd, frere, lptrar, nelt, frtptr, frtelt istep_to_iniv2, tab_pos_in_pere, lrgroups)
recursive subroutine dmumps_try_recvtreat (comm_load, ass_irecv, blocking, set_irecv, message_received, msgsou, msgtag, status, bufr, lbufr, lbufr_bytes, procnode_steps, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, nstk_s, comp, iflag, ierror, comm, perm, ipool, lpool, leaf, nbfin, myid, slavef root, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, dkeep, nd, frere, lptrar, nelt, frtptr, frtelt istep_to_iniv2, tab_pos_in_pere, stack_right_authorized, lrgroups)
subroutine dmumps_cancel_irecv (info1, keep, ass_irecv, bufr, lbufr, lbufr_bytes, comm, myid, slavef)
subroutine dmumps_clean_pending (info1, keep, bufr, lbufr, lbufr_bytes, comm_nodes, comm_load, slavef, clean_comm_nodes, clean_comm_load)

Function/Subroutine Documentation

◆ dmumps_cancel_irecv()

subroutine dmumps_cancel_irecv ( integer info1,
integer, dimension(500), intent(inout) keep,
integer ass_irecv,
integer, dimension( lbufr ) bufr,
integer lbufr,
integer lbufr_bytes,
integer comm,
integer myid,
integer slavef )

Definition at line 770 of file dfac_process_message.F.

775 USE dmumps_buf
776 IMPLICIT NONE
777 include 'mpif.h'
778 include 'mumps_tags.h'
779 INTEGER LBUFR, LBUFR_BYTES
780 INTEGER ASS_IRECV
781 INTEGER BUFR( LBUFR )
782 INTEGER COMM
783 INTEGER MYID, SLAVEF, INFO1, DEST
784 INTEGER, INTENT(INOUT) :: KEEP(500)
785 INTEGER :: STATUS(MPI_STATUS_SIZE)
786 LOGICAL NO_ACTIVE_IRECV
787 INTEGER IERR, DUMMY
788 INTRINSIC mod
789 IF (slavef .EQ. 1) RETURN
790 IF (ass_irecv.EQ.mpi_request_null) THEN
791 no_active_irecv=.true.
792 ELSE
793 CALL mpi_test(ass_irecv, no_active_irecv,
794 & status, ierr)
795 IF (no_active_irecv) THEN
796 keep(266) = keep(266) - 1
797 ENDIF
798 ENDIF
799 CALL mpi_barrier(comm,ierr)
800 dummy = 1
801 dest = mod(myid+1, slavef)
802 CALL dmumps_buf_send_1int
803 & (dummy, dest, tag_dummy, comm, keep, ierr)
804 IF (no_active_irecv) THEN
805 CALL mpi_recv( bufr, lbufr,
806 & mpi_integer, mpi_any_source,
807 & tag_dummy, comm, status, ierr )
808 ELSE
809 CALL mpi_wait(ass_irecv,
810 & status, ierr)
811 ENDIF
812 keep(266)=keep(266)-1
813 RETURN
mpi_recv
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
Definition mpi.f:461
mpi_test
subroutine mpi_test(ireq, flag, status, ierr)
Definition mpi.f:502
mpi_wait
subroutine mpi_wait(ireq, status, ierr)
Definition mpi.f:525
mpi_barrier
subroutine mpi_barrier(comm, ierr)
Definition mpi.f:188
dmumps_buf
Definition dmumps_comm_buffer.F:14
dmumps_buf::dmumps_buf_send_1int
subroutine, public dmumps_buf_send_1int(i, dest, tag, comm, keep, ierr)
Definition dmumps_comm_buffer.F:598

◆ dmumps_clean_pending()

subroutine dmumps_clean_pending ( integer, intent(in) info1,
integer, dimension(500), intent(inout) keep,
integer, dimension( lbufr ), intent(out) bufr,
integer, intent(in) lbufr,
integer, intent(in) lbufr_bytes,
integer, intent(in) comm_nodes,
integer, intent(in) comm_load,
integer, intent(in) slavef,
logical, intent(in) clean_comm_nodes,
logical, intent(in) clean_comm_load )

Definition at line 815 of file dfac_process_message.F.

819 USE dmumps_buf
820 IMPLICIT NONE
821 INTEGER, INTENT(IN) :: LBUFR, LBUFR_BYTES
822 INTEGER, INTENT(OUT) :: BUFR( LBUFR )
823 INTEGER, INTENT(IN) :: COMM_NODES, COMM_LOAD, SLAVEF, INFO1
824 INTEGER, INTENT(INOUT) :: KEEP(500)
825 LOGICAL, INTENT(IN) :: CLEAN_COMM_LOAD, CLEAN_COMM_NODES
826 include 'mpif.h'
827 include 'mumps_tags.h'
828 INTEGER :: STATUS(MPI_STATUS_SIZE)
829 LOGICAL :: FLAG, BUFFERS_EMPTY, BUFFERS_EMPTY_ON_ALL_PROCS
830 INTEGER :: MSGSOU_LOC, MSGTAG_LOC, MSGLEN_LOC
831 INTEGER :: COMM_EFF
832 INTEGER :: IERR
833 INTEGER :: IBUF_EMPTY, IBUF_EMPTY_ON_ALL_PROCS
834 INTEGER :: TOTAL_SEND_MINUS_RECV266
835 INTEGER :: TOTAL_SEND_MINUS_RECV267
836 IF (slavef.EQ.1) RETURN
837 IF (.NOT. clean_comm_nodes .AND. .NOT. clean_comm_load) THEN
838 RETURN
839 ENDIF
840 DO WHILE (.true.)
841 flag = .true.
842 DO WHILE ( flag )
843 flag = .false.
844 IF (clean_comm_nodes) THEN
845 IF ( .NOT. flag ) THEN
846 comm_eff = comm_nodes
847 CALL mpi_iprobe(mpi_any_source,mpi_any_tag,
848 & comm_nodes, flag, status, ierr)
849 END IF
850 END IF
851 IF (clean_comm_load) THEN
852 IF ( .NOT. flag ) THEN
853 comm_eff = comm_load
854 CALL mpi_iprobe( mpi_any_source, mpi_any_tag,
855 & comm_load, flag, status, ierr)
856 END IF
857 END IF
858 IF (flag) THEN
859 msgsou_loc = status( mpi_source )
860 msgtag_loc = status( mpi_tag )
861 IF (comm_eff .EQ. comm_nodes) THEN
862 keep(266) = keep(266) - 1
863 ELSE
864 keep(267) = keep(267) - 1
865 ENDIF
866 CALL mpi_get_count( status, mpi_packed, msglen_loc, ierr )
867 IF (msglen_loc .LE. lbufr_bytes) THEN
868 CALL mpi_recv( bufr, lbufr_bytes,
869 & mpi_packed, msgsou_loc,
870 & msgtag_loc, comm_eff, status, ierr )
871 ENDIF
872 ENDIF
873 END DO
874 CALL dmumps_buf_all_empty( clean_comm_nodes,
875 & clean_comm_load,
876 & buffers_empty )
877 IF ( buffers_empty ) THEN
878 ibuf_empty = 0
879 ELSE
880 ibuf_empty = 1
881 ENDIF
882 IF (clean_comm_nodes) THEN
883 comm_eff = comm_nodes
884 ELSE
885 comm_eff = comm_load
886 ENDIF
887 CALL mpi_allreduce(ibuf_empty,
888 & ibuf_empty_on_all_procs,
889 & 1, mpi_integer, mpi_max,
890 & comm_eff, ierr)
891 IF ( ibuf_empty_on_all_procs == 0) THEN
892 buffers_empty_on_all_procs = .true.
893 ELSE
894 buffers_empty_on_all_procs = .false.
895 ENDIF
896 IF (buffers_empty_on_all_procs) THEN
897 IF (clean_comm_nodes) THEN
898 CALL mpi_allreduce(keep(266),
899 & total_send_minus_recv266,
900 & 1, mpi_integer, mpi_sum,
901 & comm_eff, ierr)
902 ELSE
903 total_send_minus_recv266 = 0
904 ENDIF
905 IF (clean_comm_load) THEN
906 CALL mpi_allreduce(keep(267),
907 & total_send_minus_recv267,
908 & 1, mpi_integer, mpi_sum,
909 & comm_eff, ierr)
910 ELSE
911 total_send_minus_recv267 = 0
912 ENDIF
913 IF (total_send_minus_recv266 .EQ. 0 .AND.
914 & total_send_minus_recv267 .EQ. 0) THEN
915 EXIT
916 ENDIF
917 ENDIF
918 ENDDO
919 RETURN
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_allreduce
subroutine mpi_allreduce(sendbuf, recvbuf, cnt, datatype, operation, comm, ierr)
Definition mpi.f:103
dmumps_buf::dmumps_buf_all_empty
subroutine, public dmumps_buf_all_empty(check_comm_nodes, check_comm_load, flag)
Definition dmumps_comm_buffer.F:633

◆ dmumps_recv_and_treat()

recursive subroutine dmumps_recv_and_treat ( integer comm_load,
integer ass_irecv,
integer, dimension(mpi_status_size) status,
integer, dimension( lbufr ) bufr,
integer lbufr,
integer lbufr_bytes,
integer, dimension( keep(28) ) procnode_steps,
integer(8) posfac,
integer iwpos,
integer iwposcb,
integer(8) iptrlu,
integer(8) lrlu,
integer(8) lrlus,
integer n,
integer, dimension( liw ) iw,
integer liw,
double precision, dimension( la ) a,
integer(8) la,
integer, dimension( keep(28) ) ptrist,
integer, dimension( keep(28) ) ptlust,
integer(8), dimension(keep(28)) ptrfac,
integer(8), dimension(keep(28)) ptrast,
integer, dimension(n) step,
integer, dimension(keep(28)) pimaster,
integer(8), dimension(keep(28)) pamaster,
integer, dimension(keep(28)) nstk_s,
integer comp,
integer iflag,
integer ierror,
integer comm,
integer, dimension(n) perm,
integer, dimension( lpool ) ipool,
integer lpool,
integer leaf,
integer nbfin,
integer myid,
integer slavef,
type (dmumps_root_struc) root,
double precision opassw,
double precision opeliw,
integer, dimension( n+keep(253) ) itloc,
double precision, dimension(keep(255)) rhs_mumps,
integer, dimension( n ) fils,
integer, dimension( keep(28) ) dad,
integer(8), dimension( lptrar ), intent(in) ptrarw,
integer(8), dimension( lptrar ), intent(in) ptraiw,
integer, dimension( keep8(27) ) intarr,
double precision, dimension( keep8(26) ) dblarr,
integer, dimension(60) icntl,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
double precision, dimension(230) dkeep,
integer, dimension( keep(28) ) nd,
integer, dimension( keep(28) ) frere,
integer lptrar,
integer nelt,
integer, dimension( n+1 ) frtptr,
integer, dimension( nelt ) frtelt,
integer, dimension(keep(71)) istep_to_iniv2,
integer, dimension(slavef+2,max(1,keep(56))) tab_pos_in_pere,
integer, dimension(n), intent(in) lrgroups )

Definition at line 442 of file dfac_process_message.F.

461 USE dmumps_struc_def, ONLY : dmumps_root_struc
462 IMPLICIT NONE
463 include 'mpif.h'
464 include 'mumps_tags.h'
465 TYPE (DMUMPS_ROOT_STRUC) :: root
466 INTEGER :: STATUS(MPI_STATUS_SIZE)
467 INTEGER KEEP(500), ICNTL(60)
468 INTEGER(8) KEEP8(150)
469 DOUBLE PRECISION DKEEP(230)
470 INTEGER COMM_LOAD, ASS_IRECV
471 INTEGER LBUFR, LBUFR_BYTES
472 INTEGER BUFR( LBUFR )
473 INTEGER(8) :: POSFAC, LA, IPTRLU, LRLU, LRLUS
474 INTEGER IWPOS, IWPOSCB
475 INTEGER N, LIW
476 INTEGER IW( LIW )
477 DOUBLE PRECISION A( LA )
478 INTEGER, intent(in) :: LRGROUPS(N)
479 INTEGER(8) :: PTRFAC(KEEP(28))
480 INTEGER(8) :: PTRAST(KEEP(28))
481 INTEGER(8) :: PAMASTER(KEEP(28))
482 INTEGER PTRIST( KEEP(28) ),
483 & PTLUST( KEEP(28) )
484 INTEGER STEP(N), PIMASTER(KEEP(28))
485 INTEGER COMP
486 INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) )
487 INTEGER PERM(N)
488 INTEGER IFLAG, IERROR, COMM
489 INTEGER LPOOL, LEAF
490 INTEGER IPOOL( LPOOL )
491 INTEGER MYID, SLAVEF, NBFIN
492 DOUBLE PRECISION OPASSW, OPELIW
493 INTEGER NELT, LPTRAR
494 INTEGER FRTPTR( N+1 ), FRTELT( NELT )
495 INTEGER ITLOC( N+KEEP(253) ), FILS( N ), DAD( KEEP(28) )
496 DOUBLE PRECISION :: RHS_MUMPS(KEEP(255))
497 INTEGER(8), INTENT(IN) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR )
498 INTEGER ND( KEEP(28) ), FRERE( KEEP(28) )
499 INTEGER ISTEP_TO_INIV2(KEEP(71)),
500 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
501 INTEGER INTARR( KEEP8(27) )
502 DOUBLE PRECISION DBLARR( KEEP8(26) )
503 INTEGER MSGSOU, MSGTAG, MSGLEN, IERR
504 msgsou = status( mpi_source )
505 msgtag = status( mpi_tag )
506 CALL mpi_get_count( status, mpi_packed, msglen, ierr )
507 IF ( msglen .GT. lbufr_bytes ) THEN
508 iflag = -20
509 ierror = msglen
510 WRITE(*,*) ' RECEPTION BUF TOO SMALL, Msgtag/len=',
511 & msgtag,msglen
512 CALL dmumps_bdc_error( myid, slavef, comm, keep )
513 RETURN
514 ENDIF
515 keep(266)=keep(266)-1
516 CALL mpi_recv( bufr, lbufr_bytes, mpi_packed, msgsou,
517 & msgtag,
518 & comm, status, ierr )
519 CALL dmumps_traiter_message(
520 & comm_load, ass_irecv,
521 & msgsou, msgtag, msglen, bufr, lbufr,
522 & lbufr_bytes,
523 & procnode_steps, posfac,
524 & iwpos, iwposcb, iptrlu,
525 & lrlu, lrlus, n, iw, liw, a, la, ptrist,
526 & ptlust, ptrfac,
527 & ptrast, step, pimaster, pamaster, nstk_s, comp, iflag,
528 & ierror, comm,
529 & perm, ipool, lpool, leaf, nbfin, myid, slavef,
530 &
531 & root, opassw, opeliw, itloc, rhs_mumps,
532 & fils, dad, ptrarw, ptraiw,
533 & intarr, dblarr, icntl, keep,keep8,dkeep, nd, frere,
534 & lptrar, nelt, frtptr, frtelt,
535 &
536 & istep_to_iniv2, tab_pos_in_pere
537 & , lrgroups
538 & )
539 RETURN
dmumps_bdc_error
subroutine dmumps_bdc_error(myid, slavef, comm, keep)
Definition dbcast_int.F:38
dmumps_traiter_message
recursive subroutine dmumps_traiter_message(comm_load, ass_irecv, msgsou, msgtag, msglen, bufr, lbufr, lbufr_bytes, procnode_steps, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, nstk_s, comp, iflag, ierror, comm, perm, ipool, lpool, leaf, nbfin, myid, slavef root, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, dkeep, nd, frere, lptrar, nelt, frtptr, frtelt istep_to_iniv2, tab_pos_in_pere, lrgroups)
Definition dfac_process_message.F:33
dmumps_struc_def
Definition dmumps_struc_def.F:14
comp
int comp(int a, int b)
Definition set_surface_lines.cpp:102

◆ dmumps_traiter_message()

recursive subroutine dmumps_traiter_message ( integer comm_load,
integer ass_irecv,
integer msgsou,
integer msgtag,
integer msglen,
integer, dimension( lbufr ) bufr,
integer lbufr,
integer lbufr_bytes,
integer, dimension( keep(28) ) procnode_steps,
integer(8) posfac,
integer iwpos,
integer iwposcb,
integer(8) iptrlu,
integer(8) lrlu,
integer(8) lrlus,
integer n,
integer, dimension( liw ) iw,
integer liw,
double precision, dimension( la ) a,
integer(8) la,
integer, dimension(keep(28)) ptrist,
integer, dimension(keep(28)) ptlust,
integer(8), dimension(keep(28)) ptrfac,
integer(8), dimension(keep(28)) ptrast,
integer, dimension(n) step,
integer, dimension(keep(28)) pimaster,
integer(8), dimension(keep(28)) pamaster,
integer, dimension(keep(28)) nstk_s,
integer comp,
integer iflag,
integer ierror,
integer comm,
integer, dimension(n) perm,
integer, dimension( lpool ) ipool,
integer lpool,
integer leaf,
integer nbfin,
integer myid,
integer slavef,
type (dmumps_root_struc) root,
double precision opassw,
double precision opeliw,
integer, dimension( n+keep(253) ) itloc,
double precision, dimension(keep(255)) rhs_mumps,
integer, dimension( n ) fils,
integer, dimension(keep(28)) dad,
integer(8), dimension( lptrar ), intent(in) ptrarw,
integer(8), dimension( lptrar ), intent(in) ptraiw,
integer, dimension( keep8(27) ) intarr,
double precision, dimension( keep8(26) ) dblarr,
integer, dimension( 60 ) icntl,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
double precision, dimension(230) dkeep,
integer, dimension( keep(28) ) nd,
integer, dimension( keep(28) ) frere,
integer lptrar,
integer nelt,
integer, dimension( n+1) frtptr,
integer, dimension( nelt ) frtelt,
integer, dimension(keep(71)) istep_to_iniv2,
integer, dimension(slavef+2,max(1,keep(56))) tab_pos_in_pere,
integer, dimension(n), intent(in) lrgroups )

Definition at line 14 of file dfac_process_message.F.

33 USE dmumps_load
34 USE dmumps_struc_def, ONLY : dmumps_root_struc
35 IMPLICIT NONE
36 include 'mumps_headers.h'
37 TYPE (DMUMPS_ROOT_STRUC) :: root
38 INTEGER MSGSOU, MSGTAG, MSGLEN
39 INTEGER LBUFR, LBUFR_BYTES
40 INTEGER BUFR( LBUFR )
41 INTEGER KEEP(500), ICNTL( 60 )
42 INTEGER(8) KEEP8(150)
43 DOUBLE PRECISION DKEEP(230)
44 INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA
45 INTEGER IWPOS, IWPOSCB
46 INTEGER N, LIW
47 INTEGER IW( LIW )
48 INTEGER, intent(in) :: LRGROUPS(N)
49 DOUBLE PRECISION A( LA )
50 INTEGER(8) :: PTRFAC(KEEP(28))
51 INTEGER(8) :: PTRAST(KEEP(28))
52 INTEGER(8) :: PAMASTER(KEEP(28))
53 INTEGER PTRIST(KEEP(28)), PTLUST(KEEP(28))
54 INTEGER STEP(N), PIMASTER(KEEP(28))
55 INTEGER COMP
56 INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) )
57 INTEGER PERM(N)
58 INTEGER IFLAG, IERROR, COMM
59 INTEGER LPOOL, LEAF
60 INTEGER IPOOL( LPOOL )
61 INTEGER COMM_LOAD, ASS_IRECV
62 INTEGER MYID, SLAVEF, NBFIN
63 DOUBLE PRECISION OPASSW, OPELIW
64 INTEGER NELT, LPTRAR
65 INTEGER FRTPTR( N+1), FRTELT( NELT )
66 INTEGER ITLOC( N+KEEP(253) ), FILS( N ), DAD(KEEP(28))
67 DOUBLE PRECISION :: RHS_MUMPS(KEEP(255))
68 INTEGER(8), INTENT(IN) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR )
69 INTEGER ND( KEEP(28) ), FRERE( KEEP(28) )
70 INTEGER ISTEP_TO_INIV2(KEEP(71)),
71 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
72 INTEGER INTARR( KEEP8(27) )
73 DOUBLE PRECISION DBLARR( KEEP8(26) )
74 INTEGER INIV2, ISHIFT, IBEG
75 INTEGER ISHIFT_HDR
76 INTEGER MUMPS_PROCNODE, MUMPS_TYPENODE
77 EXTERNAL mumps_procnode, mumps_typenode
78 LOGICAL FLAG
79 INTEGER MP, LP
80 INTEGER TMP( 2 )
81 INTEGER NBRECU, POSITION, INODE, ISON, IROOT
82 INTEGER NSLAVES_PERE, NFRONT_PERE, NASS_PERE,
83 & LMAP, FPERE, NELIM,
84 & HDMAPLIG,NFS4FATHER,
85 & TOT_ROOT_SIZE, TOT_CONT_TO_RECV
86 DOUBLE PRECISION FLOP1
87 CHARACTER(LEN=35) :: SUBNAME
88 include 'mumps_tags.h'
89 include 'mpif.h'
90 INTEGER :: IERR
91 INTEGER :: STATUS(MPI_STATUS_SIZE)
92 MP = ICNTL(2)
93 LP = ICNTL(1)
94 SUBNAME="??????"
95 CALL DMUMPS_LOAD_RECV_MSGS(COMM_LOAD)
96.EQ. IF ( MSGTAG RACINE ) THEN
97 POSITION = 0
98 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NBRECU,
99 & 1, MPI_INTEGER, COMM, IERR)
100 NBRECU = BUFR( 1 )
101 NBFIN = NBFIN - NBRECU
102.EQ. ELSEIF ( MSGTAG NOEUD ) THEN
103 CALL DMUMPS_PROCESS_NODE( MYID, KEEP, KEEP8, DKEEP,
104 & BUFR, LBUFR, LBUFR_BYTES,
105 & IWPOS, IWPOSCB, IPTRLU,
106 & LRLU, LRLUS, N, IW, LIW, A, LA, SLAVEF, PROCNODE_STEPS, DAD,
107 & PTRIST, PTRAST,
108 & STEP, PIMASTER, PAMASTER,
109 & NSTK_S, COMP, FPERE, FLAG, IFLAG, IERROR, COMM,
110 & ITLOC, RHS_MUMPS )
111 SUBNAME="DMUMPS_PROCESS_NODE"
112.LT. IF ( IFLAG 0 ) GO TO 500
113 IF ( FLAG ) THEN
114 CALL DMUMPS_INSERT_POOL_N(N, IPOOL, LPOOL,
115 & PROCNODE_STEPS, SLAVEF, KEEP(199), KEEP(28), KEEP(76),
116 & KEEP(80), KEEP(47), STEP, FPERE )
117.GE. IF (KEEP(47) 3) THEN
118 CALL DMUMPS_LOAD_POOL_UPD_NEW_POOL(
119 & IPOOL, LPOOL,
120 & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD,
121 & MYID, STEP, N, ND, FILS )
122 ENDIF
123 CALL MUMPS_ESTIM_FLOPS( FPERE, N,
124 & PROCNODE_STEPS,KEEP(199),
125 & ND, FILS, FRERE, STEP, PIMASTER,
126 & KEEP(28), KEEP(50), KEEP(253), FLOP1,
127 & IW, LIW, KEEP(IXSZ) )
128.NE. IF (FPEREKEEP(20))
129 & CALL DMUMPS_LOAD_UPDATE(1,.FALSE.,FLOP1,KEEP,KEEP8)
130 ENDIF
131.EQ. ELSEIF ( MSGTAG END_NIV2_LDLT ) THEN
132 INODE = BUFR( 1 )
133 CALL DMUMPS_INSERT_POOL_N(N, IPOOL, LPOOL,
134 & PROCNODE_STEPS, SLAVEF, KEEP(199),
135 & KEEP(28), KEEP(76), KEEP(80), KEEP(47),
136 & STEP, -INODE )
137.GE. IF (KEEP(47) 3) THEN
138 CALL DMUMPS_LOAD_POOL_UPD_NEW_POOL(
139 & IPOOL, LPOOL,
140 & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD,
141 & MYID, STEP, N, ND, FILS )
142 ENDIF
143.EQ. ELSEIF ( MSGTAG TERREUR ) THEN
144 IFLAG = -001
145 IERROR = MSGSOU
146 GOTO 100
147.EQ. ELSEIF ( MSGTAG MAITRE_DESC_BANDE ) THEN
148 CALL DMUMPS_PROCESS_DESC_BANDE( MYID,BUFR, LBUFR,
149 & LBUFR_BYTES, IWPOS,
150 & IWPOSCB,
151 & IPTRLU, LRLU, LRLUS,
152 & N, IW, LIW, A, LA, SLAVEF, PROCNODE_STEPS, DAD,
153 & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, COMP,
154 & KEEP, KEEP8, DKEEP, ITLOC, RHS_MUMPS, ISTEP_TO_INIV2,
155#if ! defined (NO_FDM_DESCBAND)
156 & -1,
157#endif
158 & IFLAG, IERROR )
159 SUBNAME="DMUMPS_PROCESS_DESC_BANDE"
160.LT. IF ( IFLAG 0 ) GO to 500
161.EQ. ELSEIF ( MSGTAG MAITRE2 ) THEN
162 CALL DMUMPS_PROCESS_MASTER2(MYID,BUFR, LBUFR, LBUFR_BYTES,
163 & PROCNODE_STEPS, SLAVEF, IWPOS, IWPOSCB,
164 & IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA,
165 & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
166 & IFLAG, IERROR, COMM, COMM_LOAD,
167 & IPOOL, LPOOL, LEAF,
168 & KEEP, KEEP8, DKEEP, ND, FILS, DAD, FRERE, ITLOC, RHS_MUMPS,
169 & ISTEP_TO_INIV2, TAB_POS_IN_PERE )
170 SUBNAME="DMUMPS_PROCESS_MASTER2"
171.LT. IF ( IFLAG 0 ) GO to 500
172.EQ..OR. ELSEIF ( MSGTAG BLOC_FACTO
173.EQ. & MSGTAG BLOC_FACTO_RELAY ) THEN
174 CALL DMUMPS_PROCESS_BLOCFACTO( COMM_LOAD, ASS_IRECV,
175 & BUFR, LBUFR, LBUFR_BYTES,
176 & PROCNODE_STEPS, MSGSOU,
177 & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW,
178 & A, LA, PTRIST, PTRAST, NSTK_S, PERM,
179 & COMP, STEP, PIMASTER, PAMASTER, POSFAC,
180 & MYID, COMM , IFLAG, IERROR, NBFIN,
181 &
182 & PTLUST, PTRFAC, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
183 & FILS, DAD, PTRARW, PTRAIW, INTARR, DBLARR,
184 & ICNTL, KEEP,KEEP8,DKEEP, IPOOL, LPOOL, LEAF, ND, FRERE,
185 & LPTRAR, NELT, FRTPTR, FRTELT,
186 & ISTEP_TO_INIV2, TAB_POS_IN_PERE
187 & , LRGROUPS
188 & )
189.EQ. ELSEIF ( MSGTAG BLOC_FACTO_SYM_SLAVE ) THEN
190 CALL DMUMPS_PROCESS_BLFAC_SLAVE( COMM_LOAD, ASS_IRECV,
191 & BUFR, LBUFR,
192 & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU,
193 & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW,
194 & A, LA, PTRIST, PTRAST, NSTK_S, PERM,
195 & COMP, STEP, PIMASTER, PAMASTER, POSFAC,
196 & MYID, COMM, IFLAG, IERROR, NBFIN,
197 &
198 & PTLUST, PTRFAC, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
199 & FILS, DAD, PTRARW, PTRAIW, INTARR, DBLARR,
200 & ICNTL, KEEP,KEEP8,DKEEP, IPOOL, LPOOL, LEAF, ND, FRERE,
201 & LPTRAR, NELT, FRTPTR, FRTELT,
202 & ISTEP_TO_INIV2, TAB_POS_IN_PERE
203 & , LRGROUPS
204 & )
205.EQ. ELSEIF ( MSGTAG BLOC_FACTO_SYM ) THEN
206 CALL DMUMPS_PROCESS_SYM_BLOCFACTO( COMM_LOAD, ASS_IRECV,
207 & BUFR, LBUFR,
208 & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU,
209 & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW,
210 & A, LA, PTRIST, PTRAST, NSTK_S, PERM,
211 & COMP, STEP, PIMASTER, PAMASTER, POSFAC,
212 & MYID, COMM, IFLAG, IERROR, NBFIN,
213 &
214 & PTLUST, PTRFAC, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
215 & FILS, DAD, PTRARW, PTRAIW, INTARR, DBLARR,
216 & ICNTL,KEEP,KEEP8,DKEEP,IPOOL, LPOOL, LEAF, ND, FRERE,
217 & LPTRAR, NELT, FRTPTR, FRTELT,
218 & ISTEP_TO_INIV2, TAB_POS_IN_PERE
219 & , LRGROUPS
220 & )
221.EQ. ELSEIF ( MSGTAG CONTRIB_TYPE2 ) THEN
222 CALL DMUMPS_PROCESS_CONTRIB_TYPE2( COMM_LOAD, ASS_IRECV,
223 & MSGLEN, BUFR, LBUFR,
224 & LBUFR_BYTES, PROCNODE_STEPS,
225 & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, POSFAC,
226 & N, IW, LIW, A, LA, PTRIST,
227 & PTLUST, PTRFAC, PTRAST,
228 & STEP, PIMASTER, PAMASTER, PERM, COMP, root,
229 & OPASSW, OPELIW, ITLOC, RHS_MUMPS, NSTK_S, FILS, DAD,
230 & PTRARW, PTRAIW, INTARR, DBLARR, NBFIN, MYID, COMM,
231 & ICNTL,KEEP,KEEP8,DKEEP,IFLAG, IERROR, IPOOL, LPOOL, LEAF,
232 & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT,
233 & ISTEP_TO_INIV2, TAB_POS_IN_PERE
234 & , LRGROUPS
235 & )
236.LT. IF ( IFLAG 0 ) GO TO 100
237.EQ. ELSEIF ( MSGTAG MAPLIG ) THEN
238 HDMAPLIG = 7
239 INODE = BUFR( 1 )
240 ISON = BUFR( 2 )
241 NSLAVES_PERE = BUFR( 3 )
242 NFRONT_PERE = BUFR( 4 )
243 NASS_PERE = BUFR( 5 )
244 LMAP = BUFR( 6 )
245 NFS4FATHER = BUFR( 7 )
246.NE. IF ( NSLAVES_PERE0 ) THEN
247 INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) )
248 ISHIFT = NSLAVES_PERE+1
249 TAB_POS_IN_PERE(1:NSLAVES_PERE+1, INIV2) =
250 & BUFR(HDMAPLIG+1:HDMAPLIG+1+NSLAVES_PERE)
251 TAB_POS_IN_PERE(SLAVEF+2, INIV2) = NSLAVES_PERE
252 ELSE
253 ISHIFT = 0
254 ENDIF
255 IBEG = HDMAPLIG+1+ISHIFT
256 CALL DMUMPS_MAPLIG( COMM_LOAD, ASS_IRECV,
257 & BUFR, LBUFR, LBUFR_BYTES,
258 & INODE, ISON, NSLAVES_PERE,
259 & BUFR(IBEG),
260 & NFRONT_PERE, NASS_PERE, NFS4FATHER,LMAP,
261 & BUFR(IBEG+NSLAVES_PERE),
262 & PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB,
263 & IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA,
264 & PTRIST, PTLUST, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER,
265 & NSTK_S, COMP,
266 & IFLAG, IERROR, MYID, COMM, PERM,
267 & IPOOL, LPOOL, LEAF, NBFIN, ICNTL, KEEP,KEEP8,DKEEP, root,
268 & OPASSW, OPELIW,
269 & ITLOC, RHS_MUMPS, FILS, DAD, PTRARW, PTRAIW, INTARR, DBLARR,
270 & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT,
271 &
272 & ISTEP_TO_INIV2, TAB_POS_IN_PERE
273 & , LRGROUPS
274 & )
275.LT. IF ( IFLAG 0 ) GO TO 100
276.EQ. ELSE IF ( MSGTAG ROOT_CONT_STATIC ) THEN
277 CALL DMUMPS_PROCESS_CONTRIB_TYPE3(
278 & BUFR, LBUFR, LBUFR_BYTES,
279 & root, N, IW, LIW, A, LA,
280 & LRLU, IPTRLU, IWPOS, IWPOSCB,
281 & PTRIST, PTLUST, PTRFAC, PTRAST,
282 & STEP, PIMASTER, PAMASTER,
283 & COMP, LRLUS, IPOOL, LPOOL, LEAF,
284 & FILS, DAD, MYID,
285 & LPTRAR, NELT, FRTPTR, FRTELT,
286 & PTRAIW, PTRARW, INTARR, DBLARR,
287 & KEEP, KEEP8, DKEEP, IFLAG, IERROR, COMM, COMM_LOAD,
288 & ITLOC, RHS_MUMPS,
289 & ND, PROCNODE_STEPS, SLAVEF, OPASSW)
290 SUBNAME="DMUMPS_PROCESS_CONTRIB_TYPE3"
291.LT. IF ( IFLAG 0 ) GO TO 500
292.EQ. ELSE IF ( MSGTAG ROOT_NON_ELIM_CB ) THEN
293 IROOT = KEEP( 38 )
294 MSGSOU = MUMPS_PROCNODE( PROCNODE_STEPS(STEP(IROOT)),
295 & KEEP(199) )
296.EQ. IF ( PTLUST( STEP(IROOT)) 0 ) THEN
297 KEEP(266)=KEEP(266)-1
298 CALL MPI_RECV( TMP, 2 * KEEP(34), MPI_PACKED,
299 & MSGSOU, ROOT_2SLAVE,
300 & COMM, STATUS, IERR )
301 CALL DMUMPS_PROCESS_ROOT2SLAVE( TMP( 1 ), TMP( 2 ),
302 & root,
303 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
304 & IWPOS, IWPOSCB, IPTRLU,
305 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
306 & PTLUST, PTRFAC,
307 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
308 & IFLAG, IERROR, COMM, COMM_LOAD,
309 & IPOOL, LPOOL, LEAF,
310 & NBFIN, MYID, SLAVEF,
311 &
312 & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, DAD,
313 & LPTRAR, NELT, FRTPTR, FRTELT,
314 & PTRARW, PTRAIW,
315 & INTARR, DBLARR, ICNTL, KEEP,KEEP8, DKEEP,ND )
316 SUBNAME="DMUMPS_PROCESS_ROOT2SLAVE"
317.LT. IF ( IFLAG 0 ) GOTO 500
318 END IF
319 CALL DMUMPS_PROCESS_CONTRIB_TYPE3(
320 & BUFR, LBUFR, LBUFR_BYTES,
321 & root, N, IW, LIW, A, LA,
322 & LRLU, IPTRLU, IWPOS, IWPOSCB,
323 & PTRIST, PTLUST, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER,
324 & COMP, LRLUS, IPOOL, LPOOL, LEAF,
325 & FILS, DAD, MYID,
326 & LPTRAR, NELT, FRTPTR, FRTELT,
327 & PTRAIW, PTRARW, INTARR, DBLARR,
328 & KEEP, KEEP8, DKEEP, IFLAG, IERROR, COMM, COMM_LOAD,
329 & ITLOC, RHS_MUMPS,
330 & ND, PROCNODE_STEPS, SLAVEF, OPASSW )
331 SUBNAME="DMUMPS_PROCESS_CONTRIB_TYPE3"
332.LT. IF ( IFLAG 0 ) GO TO 500
333.EQ. ELSE IF ( MSGTAG ROOT_2SON ) THEN
334 ISON = BUFR( 1 )
335 NELIM = BUFR( 2 )
336 CALL DMUMPS_PROCESS_ROOT2SON( COMM_LOAD, ASS_IRECV,
337 & ISON, NELIM, root,
338 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
339 & IWPOS, IWPOSCB, IPTRLU,
340 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
341 & PTLUST, PTRFAC,
342 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
343 & IFLAG, IERROR, COMM,
344 & PERM, IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
345 &
346 & OPASSW, OPELIW, ITLOC, RHS_MUMPS,
347 & FILS, DAD, PTRARW, PTRAIW,
348 & INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND, FRERE,
349 & LPTRAR, NELT, FRTPTR, FRTELT,
350 & ISTEP_TO_INIV2, TAB_POS_IN_PERE
351 & , LRGROUPS
352 & )
353.LT. IF ( IFLAG 0 ) GO TO 100
354.NE. IF ( MYIDMUMPS_PROCNODE(PROCNODE_STEPS(STEP(ISON)),
355 & KEEP(199)) ) THEN
356.EQ. IF (KEEP(50)0) THEN
357 ISHIFT_HDR = 6
358 ELSE
359 ISHIFT_HDR = 8
360 ENDIF
361.EQ. IF (IW(PTRIST(STEP(ISON))+ISHIFT_HDR+KEEP(IXSZ))
362 & S_REC_CONTSTATIC) THEN
363 IW(PTRIST(STEP(ISON))+ISHIFT_HDR+KEEP(IXSZ)) =
364 & S_ROOT2SON_CALLED
365 ELSE
366 CALL DMUMPS_FREE_BAND( N, ISON, PTRIST, PTRAST,
367 & IW, LIW, A, LA, LRLU, LRLUS, IWPOSCB,
368 & IPTRLU, STEP, MYID, KEEP, KEEP8,
369 & MUMPS_TYPENODE(PROCNODE_STEPS(STEP(ISON)),KEEP(199))
370 & )
371 ENDIF
372 ENDIF
373.EQ. ELSE IF ( MSGTAG ROOT_2SLAVE ) THEN
374 TOT_ROOT_SIZE = BUFR( 1 )
375 TOT_CONT_TO_RECV = BUFR( 2 )
376 CALL DMUMPS_PROCESS_ROOT2SLAVE( TOT_ROOT_SIZE,
377 & TOT_CONT_TO_RECV, root,
378 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
379 & IWPOS, IWPOSCB, IPTRLU,
380 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
381 & PTLUST, PTRFAC,
382 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
383 & IFLAG, IERROR, COMM, COMM_LOAD,
384 & IPOOL, LPOOL, LEAF,
385 & NBFIN, MYID, SLAVEF,
386 &
387 & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, DAD,
388 & LPTRAR, NELT, FRTPTR, FRTELT,
389 & PTRARW, PTRAIW,
390 & INTARR, DBLARR, ICNTL, KEEP,KEEP8, DKEEP, ND )
391.LT. IF ( IFLAG 0 ) GO TO 100
392.EQ. ELSE IF ( MSGTAG ROOT_NELIM_INDICES ) THEN
393 ISON = BUFR( 1 )
394 NELIM = BUFR( 2 )
395 NSLAVES_PERE = BUFR( 3 )
396 CALL DMUMPS_PROCESS_RTNELIND( root,
397 & ISON, NELIM, NSLAVES_PERE, BUFR(4), BUFR(4+BUFR(2)),
398 & BUFR(4+2*BUFR(2)),
399 &
400 & PROCNODE_STEPS,
401 & IWPOS, IWPOSCB, IPTRLU,
402 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
403 & PTLUST, PTRFAC,
404 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S,
405 & ITLOC, RHS_MUMPS, COMP,
406 & IFLAG, IERROR,
407 & IPOOL, LPOOL, LEAF, MYID, SLAVEF,
408 & KEEP, KEEP8, DKEEP,
409 & COMM, COMM_LOAD, FILS, DAD, ND)
410 SUBNAME="DMUMPS_PROCESS_RTNELIND"
411.LT. IF ( IFLAG 0 ) GO TO 500
412.EQ. ELSE IF ( MSGTAG UPDATE_LOAD ) THEN
413 WRITE(*,*) "Internal error 3 in DMUMPS_TRAITER_MESSAGE"
414 CALL MUMPS_ABORT()
415.EQ. ELSE IF ( MSGTAG TAG_DUMMY ) THEN
416 ELSE
417 IF ( LP > 0 )
418 & WRITE(LP,*) MYID,
419 &': internal error, routine dmumps_traiter_message.',MSGTAG
420 IFLAG = -100
421 IERROR= MSGTAG
422 GOTO 500
423 ENDIF
424 100 CONTINUE
425 RETURN
426 500 CONTINUE
427.GT..AND..GE. IF ( ICNTL(1) 0 ICNTL(4)1 ) THEN
428 LP=ICNTL(1)
429.EQ. IF (IFLAG-9) THEN
430 WRITE(LP,*) 'failure, workspace too small during ',SUBNAME
431 ENDIF
432.EQ. IF (IFLAG-8) THEN
433 WRITE(LP,*) 'failure in INTEGER ALLOCATION DURING ',SUBNAME
434 ENDIF
435.EQ. IF (IFLAG-13) THEN
436 WRITE(LP,*) 'FAILURE IN DYNAMIC ALLOCATION DURING ',SUBNAME
437 ENDIF
438 ENDIF
439 CALL DMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
440 RETURN
dmumps_load
Definition dmumps_load.F:14
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

◆ dmumps_try_recvtreat()

recursive subroutine dmumps_try_recvtreat ( integer comm_load,
integer ass_irecv,
logical, intent(in) blocking,
logical, intent(in) set_irecv,
logical, intent(inout) message_received,
integer, intent(in) msgsou,
integer, intent(in) msgtag,
integer, dimension(mpi_status_size) status,
integer, dimension( lbufr ) bufr,
integer lbufr,
integer lbufr_bytes,
integer, dimension( keep(28) ) procnode_steps,
integer(8) posfac,
integer iwpos,
integer iwposcb,
integer(8) iptrlu,
integer(8) lrlu,
integer(8) lrlus,
integer n,
integer, dimension( liw ) iw,
integer liw,
double precision, dimension( la ) a,
integer(8) la,
integer, dimension( keep(28) ) ptrist,
integer, dimension(keep(28)) ptlust,
integer(8), dimension(keep(28)) ptrfac,
integer(8), dimension(keep(28)) ptrast,
integer, dimension(n) step,
integer, dimension(keep(28)) pimaster,
integer(8), dimension(keep(28)) pamaster,
integer, dimension(keep(28)) nstk_s,
integer comp,
integer iflag,
integer ierror,
integer comm,
integer, dimension(n) perm,
integer, dimension( lpool ) ipool,
integer lpool,
integer leaf,
integer nbfin,
integer myid,
integer slavef,
type (dmumps_root_struc) root,
double precision opassw,
double precision opeliw,
integer, dimension( n + keep(253) ) itloc,
double precision, dimension(keep(255)) rhs_mumps,
integer, dimension( n ) fils,
integer, dimension( keep(28) ) dad,
integer(8), dimension( lptrar ), intent(in) ptrarw,
integer(8), dimension( lptrar ), intent(in) ptraiw,
integer, dimension( keep8(27) ) intarr,
double precision, dimension( keep8(26) ) dblarr,
integer, dimension(60) icntl,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
double precision, dimension(230) dkeep,
integer, dimension( keep(28) ) nd,
integer, dimension( keep(28) ) frere,
integer lptrar,
integer nelt,
integer, dimension( n+1 ) frtptr,
integer, dimension( nelt ) frtelt,
integer, dimension(keep(71)) istep_to_iniv2,
integer, dimension(slavef+2,max(1,keep(56))) tab_pos_in_pere,
logical, intent(in) stack_right_authorized,
integer, dimension(n), intent(in) lrgroups )

Definition at line 541 of file dfac_process_message.F.

560 USE dmumps_load
561 USE dmumps_struc_def, ONLY : dmumps_root_struc
562 IMPLICIT NONE
563 include 'mpif.h'
564 include 'mumps_tags.h'
565 TYPE (DMUMPS_ROOT_STRUC) :: root
566 INTEGER :: STATUS(MPI_STATUS_SIZE)
567 LOGICAL, INTENT (IN) :: BLOCKING
568 LOGICAL, INTENT (IN) :: SET_IRECV
569 LOGICAL, INTENT (INOUT) :: MESSAGE_RECEIVED
570 INTEGER, INTENT (IN) :: MSGSOU, MSGTAG
571 INTEGER KEEP(500), ICNTL(60)
572 INTEGER(8) KEEP8(150)
573 DOUBLE PRECISION DKEEP(230)
574 INTEGER LBUFR, LBUFR_BYTES
575 INTEGER COMM_LOAD, ASS_IRECV
576 INTEGER BUFR( LBUFR )
577 INTEGER(8) :: LA, POSFAC, IPTRLU, LRLU, LRLUS
578 INTEGER IWPOS, IWPOSCB
579 INTEGER N, LIW
580 INTEGER IW( LIW )
581 DOUBLE PRECISION A( LA )
582 INTEGER, intent(in) :: LRGROUPS(N)
583 INTEGER(8) :: PTRAST(KEEP(28))
584 INTEGER(8) :: PTRFAC(KEEP(28))
585 INTEGER(8) :: PAMASTER(KEEP(28))
586 INTEGER PTRIST( KEEP(28) ),
587 & PTLUST(KEEP(28))
588 INTEGER STEP(N),
589 & PIMASTER(KEEP(28))
590 INTEGER COMP
591 INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) )
592 INTEGER PERM(N)
593 INTEGER IFLAG, IERROR, COMM
594 INTEGER LPOOL, LEAF
595 INTEGER IPOOL( LPOOL )
596 INTEGER MYID, SLAVEF, NBFIN
597 DOUBLE PRECISION OPASSW, OPELIW
598 INTEGER NELT, LPTRAR
599 INTEGER FRTPTR( N+1 ), FRTELT( NELT )
600 INTEGER ITLOC( N + KEEP(253) ), FILS( N ), DAD( KEEP(28) )
601 DOUBLE PRECISION :: RHS_MUMPS(KEEP(255))
602 INTEGER(8), INTENT(IN) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR )
603 INTEGER ND( KEEP(28) ), FRERE( KEEP(28) )
604 INTEGER ISTEP_TO_INIV2(KEEP(71)),
605 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
606 INTEGER INTARR( KEEP8(27) )
607 DOUBLE PRECISION DBLARR( KEEP8(26) )
608 LOGICAL, intent(in) :: STACK_RIGHT_AUTHORIZED
609 LOGICAL FLAG, RIGHT_MESS, FLAGbis
610 INTEGER LP, MSGSOU_LOC, MSGTAG_LOC, MSGLEN_LOC
611 INTEGER IERR
612 INTEGER :: STATUS_BIS(MPI_STATUS_SIZE)
613 INTEGER, SAVE :: RECURS = 0
614 CALL dmumps_load_recv_msgs(comm_load)
615 IF ( .NOT. stack_right_authorized ) THEN
616 RETURN
617 ENDIF
618 recurs = recurs + 1
619 lp = icntl(1)
620 IF (icntl(4).LT.1) lp=-1
621 IF ( message_received ) THEN
622 msgsou_loc = mpi_any_source
623 msgtag_loc = mpi_any_tag
624 GOTO 250
625 ENDIF
626 IF ( ass_irecv .NE. mpi_request_null) THEN
627 IF (keep(117).NE.0) THEN
628 WRITE(*,*) "Problem of active IRECV with KEEP(117)=",keep(117)
629 CALL mumps_abort()
630 ENDIF
631 right_mess = .true.
632 IF (blocking) THEN
633 CALL mpi_wait(ass_irecv,
634 & status, ierr)
635 flag = .true.
636 IF ( ( (msgsou.NE.mpi_any_source) .OR.
637 & (msgtag.NE.mpi_any_tag) ) ) THEN
638 IF ( msgsou.NE.mpi_any_source) THEN
639 right_mess = msgsou.EQ.status(mpi_source)
640 ENDIF
641 IF ( msgtag.NE.mpi_any_tag) THEN
642 right_mess =
643 & ( (msgtag.EQ.status(mpi_tag)).AND.right_mess )
644 ENDIF
645 IF (.NOT.right_mess) THEN
646 CALL mpi_probe(msgsou,msgtag,
647 & comm, status_bis, ierr)
648 ENDIF
649 ENDIF
650 ELSE
651 CALL mpi_test(ass_irecv,
652 & flag, status, ierr)
653 ENDIF
654 IF (ierr.LT.0) THEN
655 iflag = -20
656 IF (lp.GT.0)
657 & write(lp,*) ' Error return from MPI_TEST ',
658 & iflag, ' in DMUMPS_TRY_RECVTREAT'
659 CALL dmumps_bdc_error( myid, slavef, comm, keep )
660 RETURN
661 ENDIF
662 IF ( flag ) THEN
663 keep(266)=keep(266)-1
664 message_received = .true.
665 msgsou_loc = status( mpi_source )
666 msgtag_loc = status( mpi_tag )
667 CALL mpi_get_count( status, mpi_packed, msglen_loc, ierr )
668 IF (.NOT.right_mess) recurs = recurs + 10
669 CALL dmumps_traiter_message( comm_load, ass_irecv,
670 & msgsou_loc, msgtag_loc, msglen_loc, bufr, lbufr,
671 & lbufr_bytes,
672 & procnode_steps, posfac,
673 & iwpos, iwposcb, iptrlu,
674 & lrlu, lrlus, n, iw, liw, a, la,
675 & ptrist, ptlust, ptrfac,
676 & ptrast, step, pimaster, pamaster, nstk_s, comp, iflag,
677 & ierror, comm,
678 & perm, ipool, lpool, leaf, nbfin, myid, slavef,
679 &
680 & root, opassw, opeliw, itloc, rhs_mumps, fils, dad,
681 & ptrarw, ptraiw,
682 & intarr, dblarr, icntl, keep,keep8,dkeep, nd, frere,
683 & lptrar, nelt, frtptr, frtelt,
684 & istep_to_iniv2, tab_pos_in_pere
685 & , lrgroups
686 & )
687 IF (.NOT.right_mess) recurs = recurs - 10
688 IF ( iflag .LT. 0 ) RETURN
689 IF (.NOT.right_mess) THEN
690 IF (ass_irecv .NE. mpi_request_null) THEN
691 CALL mumps_abort()
692 ENDIF
693 CALL mpi_iprobe(msgsou,msgtag,
694 & comm, flagbis, status, ierr)
695 IF (flagbis) THEN
696 msgsou_loc = status( mpi_source )
697 msgtag_loc = status( mpi_tag )
698 CALL dmumps_recv_and_treat( comm_load, ass_irecv,
699 & status, bufr, lbufr,
700 & lbufr_bytes,
701 & procnode_steps, posfac,
702 & iwpos, iwposcb, iptrlu,
703 & lrlu, lrlus, n, iw, liw, a, la,
704 & ptrist, ptlust, ptrfac,
705 & ptrast, step, pimaster, pamaster,
706 & nstk_s, comp, iflag,
707 & ierror, comm,
708 & perm, ipool, lpool,leaf,nbfin,myid,slavef,
709 &
710 & root, opassw, opeliw, itloc, rhs_mumps,
711 & fils, dad, ptrarw, ptraiw,
712 & intarr, dblarr, icntl,
713 & keep,keep8, dkeep,nd, frere,
714 & lptrar, nelt, frtptr, frtelt,
715 & istep_to_iniv2, tab_pos_in_pere
716 & , lrgroups
717 & )
718 IF ( iflag .LT. 0 ) RETURN
719 ENDIF
720 ENDIF
721 ENDIF
722 ELSE
723 IF (blocking) THEN
724 CALL mpi_probe(msgsou,msgtag,
725 & comm, status, ierr)
726 flag = .true.
727 ELSE
728 CALL mpi_iprobe( mpi_any_source, mpi_any_tag,
729 & comm, flag, status, ierr)
730 ENDIF
731 IF (flag) THEN
732 msgsou_loc = status( mpi_source )
733 msgtag_loc = status( mpi_tag )
734 message_received = .true.
735 CALL dmumps_recv_and_treat( comm_load, ass_irecv,
736 & status, bufr, lbufr,
737 & lbufr_bytes,
738 & procnode_steps, posfac,
739 & iwpos, iwposcb, iptrlu,
740 & lrlu, lrlus, n, iw, liw, a, la,
741 & ptrist, ptlust, ptrfac,
742 & ptrast, step, pimaster, pamaster, nstk_s, comp, iflag,
743 & ierror, comm,
744 & perm, ipool, lpool, leaf, nbfin, myid, slavef,
745 &
746 & root, opassw, opeliw, itloc, rhs_mumps,
747 & fils, dad, ptrarw, ptraiw,
748 & intarr, dblarr, icntl, keep,keep8,dkeep, nd, frere,
749 & lptrar, nelt, frtptr, frtelt,
750 & istep_to_iniv2, tab_pos_in_pere
751 & , lrgroups
752 & )
753 IF ( iflag .LT. 0 ) RETURN
754 ENDIF
755 ENDIF
756 250 CONTINUE
757 recurs = recurs - 1
758 IF ( nbfin .EQ. 0 ) RETURN
759 IF ( recurs .GT. 3 ) RETURN
760 IF ( keep(36).EQ.1 .AND. set_irecv .AND.
761 & (ass_irecv.EQ.mpi_request_null) .AND.
762 & message_received ) THEN
763 CALL mpi_irecv ( bufr(1),
764 & lbufr_bytes, mpi_packed, mpi_any_source,
765 & mpi_any_tag, comm,
766 & ass_irecv, ierr )
767 ENDIF
768 RETURN
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
dmumps_recv_and_treat
recursive subroutine dmumps_recv_and_treat(comm_load, ass_irecv, status, bufr, lbufr, lbufr_bytes, procnode_steps, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, nstk_s, comp, iflag, ierror, comm, perm, ipool, lpool, leaf, nbfin, myid, slavef root, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, dkeep, nd, frere, lptrar, nelt, frtptr, frtelt istep_to_iniv2, tab_pos_in_pere, lrgroups)
Definition dfac_process_message.F:461
mpi_probe
subroutine mpi_probe(source, tag, comm, status, ierr)
Definition mpi.f:449
mpi_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
dmumps_load::dmumps_load_recv_msgs
recursive subroutine, public dmumps_load_recv_msgs(comm)
Definition dmumps_load.F:1179
dmumps_load::myid
integer, save, private myid
Definition dmumps_load.F:57