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

Go to the source code of this file.

Functions/Subroutines

recursive subroutine smumps_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 smumps_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 smumps_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 smumps_cancel_irecv (info1, keep, ass_irecv, bufr, lbufr, lbufr_bytes, comm, myid, slavef)
subroutine smumps_clean_pending (info1, keep, bufr, lbufr, lbufr_bytes, comm_nodes, comm_load, slavef, clean_comm_nodes, clean_comm_load)

Function/Subroutine Documentation

◆ smumps_cancel_irecv()

subroutine smumps_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 sfac_process_message.F.

775 USE smumps_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 smumps_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
smumps_buf
Definition smumps_comm_buffer.F:14
smumps_buf::smumps_buf_send_1int
subroutine, public smumps_buf_send_1int(i, dest, tag, comm, keep, ierr)
Definition smumps_comm_buffer.F:598

◆ smumps_clean_pending()

subroutine smumps_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 sfac_process_message.F.

819 USE smumps_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 smumps_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
smumps_buf::smumps_buf_all_empty
subroutine, public smumps_buf_all_empty(check_comm_nodes, check_comm_load, flag)
Definition smumps_comm_buffer.F:633

◆ smumps_recv_and_treat()

recursive subroutine smumps_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,
real, 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 (smumps_root_struc) root,
double precision opassw,
double precision opeliw,
integer, dimension( n+keep(253) ) itloc,
real, 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,
real, dimension( keep8(26) ) dblarr,
integer, dimension(60) icntl,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
real, 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 sfac_process_message.F.

461 USE smumps_struc_def, ONLY : smumps_root_struc
462 IMPLICIT NONE
463 include 'mpif.h'
464 include 'mumps_tags.h'
465 TYPE (SMUMPS_ROOT_STRUC) :: root
466 INTEGER :: STATUS(MPI_STATUS_SIZE)
467 INTEGER KEEP(500), ICNTL(60)
468 INTEGER(8) KEEP8(150)
469 REAL 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 REAL 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 REAL :: 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 REAL 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 smumps_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 smumps_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
smumps_struc_def
Definition smumps_struc_def.F:14
smumps_bdc_error
subroutine smumps_bdc_error(myid, slavef, comm, keep)
Definition sbcast_int.F:38
comp
int comp(int a, int b)
Definition set_surface_lines.cpp:102
smumps_traiter_message
recursive subroutine smumps_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 sfac_process_message.F:33

◆ smumps_traiter_message()

recursive subroutine smumps_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,
real, 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 (smumps_root_struc) root,
double precision opassw,
double precision opeliw,
integer, dimension( n+keep(253) ) itloc,
real, 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,
real, dimension( keep8(26) ) dblarr,
integer, dimension( 60 ) icntl,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
real, 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 sfac_process_message.F.

33 USE smumps_load
34 USE smumps_struc_def, ONLY : smumps_root_struc
35 IMPLICIT NONE
36 include 'mumps_headers.h'
37 TYPE (SMUMPS_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 REAL 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 REAL 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 REAL :: 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 REAL 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 smumps_load_recv_msgs(comm_load)
96 IF ( msgtag .EQ. 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 ELSEIF ( msgtag .EQ. noeud ) THEN
103 CALL smumps_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="SMUMPS_PROCESS_NODE"
112 IF ( iflag .LT. 0 ) GO TO 500
113 IF ( flag ) THEN
114 CALL smumps_insert_pool_n(n, ipool, lpool,
115 & procnode_steps, slavef, keep(199), keep(28), keep(76),
116 & keep(80), keep(47), step, fpere )
117 IF (keep(47) .GE. 3) THEN
118 CALL smumps_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 IF (fpere.NE.keep(20))
129 & CALL smumps_load_update(1,.false.,flop1,keep,keep8)
130 ENDIF
131 ELSEIF ( msgtag .EQ. end_niv2_ldlt ) THEN
132 inode = bufr( 1 )
133 CALL smumps_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 IF (keep(47) .GE. 3) THEN
138 CALL smumps_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 ELSEIF ( msgtag .EQ. terreur ) THEN
144 iflag = -001
145 ierror = msgsou
146 GOTO 100
147 ELSEIF ( msgtag .EQ. maitre_desc_bande ) THEN
148 CALL smumps_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="SMUMPS_PROCESS_DESC_BANDE"
160 IF ( iflag .LT. 0 ) GO to 500
161 ELSEIF ( msgtag .EQ. maitre2 ) THEN
162 CALL smumps_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="SMUMPS_PROCESS_MASTER2"
171 IF ( iflag .LT. 0 ) GO to 500
172 ELSEIF ( msgtag .EQ. bloc_facto .OR.
173 & msgtag .EQ. bloc_facto_relay ) THEN
174 CALL smumps_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 ELSEIF ( msgtag .EQ. bloc_facto_sym_slave ) THEN
190 CALL smumps_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 ELSEIF ( msgtag .EQ. bloc_facto_sym ) THEN
206 CALL smumps_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 ELSEIF ( msgtag .EQ. contrib_type2 ) THEN
222 CALL smumps_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 IF ( iflag .LT. 0 ) GO TO 100
237 ELSEIF ( msgtag .EQ. 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 IF ( nslaves_pere.NE.0 ) 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 smumps_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 IF ( iflag .LT. 0 ) GO TO 100
276 ELSE IF ( msgtag .EQ. root_cont_static ) THEN
277 CALL smumps_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="SMUMPS_PROCESS_CONTRIB_TYPE3"
291 IF ( iflag .LT. 0 ) GO TO 500
292 ELSE IF ( msgtag .EQ. root_non_elim_cb ) THEN
293 iroot = keep( 38 )
294 msgsou = mumps_procnode( procnode_steps(step(iroot)),
295 & keep(199) )
296 IF ( ptlust( step(iroot)) .EQ. 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 smumps_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="SMUMPS_PROCESS_ROOT2SLAVE"
317 IF ( iflag .LT. 0 ) GOTO 500
318 END IF
319 CALL smumps_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="SMUMPS_PROCESS_CONTRIB_TYPE3"
332 IF ( iflag .LT. 0 ) GO TO 500
333 ELSE IF ( msgtag .EQ. root_2son ) THEN
334 ison = bufr( 1 )
335 nelim = bufr( 2 )
336 CALL smumps_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 IF ( iflag .LT. 0 ) GO TO 100
354 IF ( myid.NE.mumps_procnode(procnode_steps(step(ison)),
355 & keep(199)) ) THEN
356 IF (keep(50).EQ.0) THEN
357 ishift_hdr = 6
358 ELSE
359 ishift_hdr = 8
360 ENDIF
361 IF (iw(ptrist(step(ison))+ishift_hdr+keep(ixsz)).EQ.
362 & s_rec_contstatic) THEN
363 iw(ptrist(step(ison))+ishift_hdr+keep(ixsz)) =
364 & s_root2son_called
365 ELSE
366 CALL smumps_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 ELSE IF ( msgtag .EQ. root_2slave ) THEN
374 tot_root_size = bufr( 1 )
375 tot_cont_to_recv = bufr( 2 )
376 CALL smumps_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 IF ( iflag .LT. 0 ) GO TO 100
392 ELSE IF ( msgtag .EQ. root_nelim_indices ) THEN
393 ison = bufr( 1 )
394 nelim = bufr( 2 )
395 nslaves_pere = bufr( 3 )
396 CALL smumps_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="SMUMPS_PROCESS_RTNELIND"
411 IF ( iflag .LT. 0 ) GO TO 500
412 ELSE IF ( msgtag .EQ. update_load ) THEN
413 WRITE(*,*) "Internal error 3 in SMUMPS_TRAITER_MESSAGE"
414 CALL mumps_abort()
415 ELSE IF ( msgtag .EQ. tag_dummy ) THEN
416 ELSE
417 IF ( lp > 0 )
418 & WRITE(lp,*) myid,
419 &': Internal error, routine SMUMPS_TRAITER_MESSAGE.',msgtag
420 iflag = -100
421 ierror= msgtag
422 GOTO 500
423 ENDIF
424 100 CONTINUE
425 RETURN
426 500 CONTINUE
427 IF ( icntl(1) .GT. 0 .AND. icntl(4).GE.1 ) THEN
428 lp=icntl(1)
429 IF (iflag.EQ.-9) THEN
430 WRITE(lp,*) 'FAILURE, WORKSPACE TOO SMALL DURING ',subname
431 ENDIF
432 IF (iflag.EQ.-8) THEN
433 WRITE(lp,*) 'FAILURE IN INTEGER ALLOCATION DURING ',subname
434 ENDIF
435 IF (iflag.EQ.-13) THEN
436 WRITE(lp,*) 'FAILURE IN DYNAMIC ALLOCATION DURING ',subname
437 ENDIF
438 ENDIF
439 CALL smumps_bdc_error( myid, slavef, comm, keep )
440 RETURN
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
mumps_estim_flops
subroutine mumps_estim_flops(inode, n, procnode_steps, keep199, nd, fils, frere_steps, step, pimaster, keep28, keep50, keep253, flop1, iw, liw, xsize)
Definition estim_flops.F:20
mpi_unpack
subroutine mpi_unpack(inbuf, insize, position, outbuf, outcnt, datatype, comm, ierr)
Definition mpi.f:514
smumps_load
Definition smumps_load.F:14
smumps_load::smumps_load_recv_msgs
recursive subroutine, public smumps_load_recv_msgs(comm)
Definition smumps_load.F:1179
smumps_load::smumps_load_pool_upd_new_pool
subroutine, public smumps_load_pool_upd_new_pool(pool, lpool, procnode, keep, keep8, slavef, comm, myid, step, n, nd, fils)
Definition smumps_load.F:1820
smumps_load::myid
integer, save, private myid
Definition smumps_load.F:57
smumps_load::smumps_load_update
subroutine, public smumps_load_update(check_flops, process_bande, inc_load, keep, keep8)
Definition smumps_load.F:824
smumps_process_desc_bande
subroutine smumps_process_desc_bande(myid, bufr, lbufr, lbufr_bytes, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, slavef, procnode_steps, dad, ptrist, ptrast, step, pimaster, pamaster, comp, keep, keep8, dkeep, itloc, rhs_mumps, istep_to_iniv2, iwhandler_in, iflag, ierror)
Definition sfac_process_band.F:25
smumps_process_blfac_slave
recursive subroutine smumps_process_blfac_slave(comm_load, ass_irecv, bufr, lbufr, lbufr_bytes, procnode_steps, msgsou, slavef, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptrast, nstk_s, perm, comp, step, pimaster, pamaster, posfac, myid, comm, iflag, ierror, nbfin ptlust_s, ptrfac, root, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, dkeep, ipool, lpool, leaf, nd, frere_steps, lptrar, nelt, frtptr, frtelt, istep_to_iniv2, tab_pos_in_pere, lrgroups)
Definition sfac_process_blfac_slave.F:31
smumps_process_blocfacto
recursive subroutine smumps_process_blocfacto(comm_load, ass_irecv, bufr, lbufr, lbufr_bytes, procnode_steps, msgsou, slavef, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptrast, nstk_s, perm, comp, step, pimaster, pamaster, posfac, myid, comm, iflag, ierror, nbfin ptlust_s, ptrfac, root, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, dkeep, ipool, lpool, leaf, nd, frere_steps, lptrar, nelt, frtptr, frtelt, istep_to_iniv2, tab_pos_in_pere, lrgroups)
Definition sfac_process_blocfacto.F:32
smumps_process_sym_blocfacto
recursive subroutine smumps_process_sym_blocfacto(comm_load, ass_irecv, bufr, lbufr, lbufr_bytes, procnode_steps, msgsou, slavef, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptrast, nstk_s, perm, comp, step, pimaster, pamaster, posfac, myid, comm, iflag, ierror, nbfin ptlust_s, ptrfac, root, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, dkeep, ipool, lpool, leaf, nd, frere_steps, lptrar, nelt, frtptr, frtelt, istep_to_iniv2, tab_pos_in_pere, lrgroups)
Definition sfac_process_blocfacto_LDLT.F:31
smumps_process_node
subroutine smumps_process_node(myid, keep, keep8, dkeep, bufr, lbufr, lbufr_bytes, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, slavef, procnode_steps, dad, ptrist, ptrast, step, pimaster, pamaster, nstk_s, comp, fpere, flag, iflag, ierror, comm, itloc, rhs_mumps)
Definition sfac_process_contrib_type1.F:22
smumps_process_contrib_type2
subroutine smumps_process_contrib_type2(comm_load, ass_irecv, msglen, bufr, lbufr, lbufr_bytes, procnode_steps, slavef, iwpos, iwposcb, iptrlu, lrlu, lrlus, posfac, n, iw, liw, a, la, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, perm, comp, root, opassw, opeliw, itloc, rhs_mumps, nstk_s, fils, dad, ptrarw, ptraiw, intarr, dblarr, nbfin, myid, comm, icntl, keep, keep8, dkeep, iflag, ierror, ipool, lpool, leaf, nd, frere_steps, lptrar, nelt, frtptr, frtelt, istep_to_iniv2, tab_pos_in_pere, lrgroups)
Definition sfac_process_contrib_type2.F:28
smumps_process_contrib_type3
subroutine smumps_process_contrib_type3(bufr, lbufr, lbufr_bytes, root, n, iw, liw, a, la, lrlu, iptrlu, iwpos, iwposcb, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, comp, lrlus, ipool, lpool, leaf, fils, dad, myid, lptrar, nelt, frtptr, frtelt, ptraiw, ptrarw, intarr, dblarr, keep, keep8, dkeep, iflag, ierror, comm, comm_load, itloc, rhs_mumps, nd, procnode_steps, slavef, opassw)
Definition sfac_process_contrib_type3.F:26
smumps_maplig
recursive subroutine smumps_maplig(comm_load, ass_irecv, bufr, lbufr, lbufr_bytes inode_pere, ison, nslaves_pere, list_slaves_pere, nfront_pere, nass_pere, nfs4father, lmap, trow, procnode_steps, slavef, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, nstk, comp, iflag, ierror, myid, comm, perm, ipool, lpool, leaf, nbfin, icntl, keep, keep8, dkeep, root, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, nd, frere, lptrar, nelt, frtptr, frtelt, istep_to_iniv2, tab_pos_in_pere, lrgroups)
Definition sfac_process_maprow.F:34
smumps_process_master2
subroutine smumps_process_master2(myid, bufr, lbufr, lbufr_bytes, procnode_steps, slavef, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptrast, step, pimaster, pamaster, nstk_s, comp, iflag, ierror, comm, comm_load, ipool, lpool, leaf, keep, keep8, dkeep, nd, fils, dad, frere, itloc, rhs_mumps, istep_to_iniv2, tab_pos_in_pere)
Definition sfac_process_master2.F:25
smumps_process_root2slave
subroutine smumps_process_root2slave(tot_root_size, tot_cont_to_recv, root, 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, comm_load, ipool, lpool, leaf, nbfin, myid, slavef opassw, opeliw, itloc, rhs_mumps, fils, dad, lptrar, nelt, frtptr, frtelt, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, dkeep, nd)
Definition sfac_process_root2slave.F:30
smumps_process_root2son
recursive subroutine smumps_process_root2son(comm_load, ass_irecv, inode, nelim_root, root, bufr, lbufr, lbufr_bytes, procnode_steps, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust_s, ptrfac, ptrast, step, pimaster, pamaster, nstk_s, comp, iflag, ierror, comm, perm, ipool, lpool, leaf, nbfin, myid, slavef 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 sfac_process_root2son.F:33
smumps_process_rtnelind
subroutine smumps_process_rtnelind(root, inode, nelim, nslaves, row_list, col_list, slave_list, procnode_steps, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust_s, ptrfac, ptrast, step, pimaster, pamaster, nstk_s, itloc, rhs_mumps, comp, iflag, ierror, ipool, lpool, leaf, myid, slavef, keep, keep8, dkeep, comm, comm_load, fils, dad, nd)
Definition sfac_process_rtnelind.F:27
smumps_insert_pool_n
subroutine smumps_insert_pool_n(n, pool, lpool, procnode, slavef, keep199, k28, k76, k80, k47, step, inode)
Definition sfac_sol_pool.F:27
smumps_free_band
subroutine smumps_free_band(n, ison, ptrist, ptrast, iw, liw, a, la, lrlu, lrlus, iwposcb, iptrlu, step, myid, keep, keep8, type_son)
Definition stools.F:461
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

◆ smumps_try_recvtreat()

recursive subroutine smumps_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,
real, 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 (smumps_root_struc) root,
double precision opassw,
double precision opeliw,
integer, dimension( n + keep(253) ) itloc,
real, 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,
real, dimension( keep8(26) ) dblarr,
integer, dimension(60) icntl,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
real, 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 sfac_process_message.F.

560 USE smumps_load
561 USE smumps_struc_def, ONLY : smumps_root_struc
562 IMPLICIT NONE
563 include 'mpif.h'
564 include 'mumps_tags.h'
565 TYPE (SMUMPS_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 REAL 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 REAL 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 REAL :: 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 REAL 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 smumps_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 SMUMPS_TRY_RECVTREAT'
659 CALL smumps_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 smumps_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 smumps_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 smumps_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
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
smumps_recv_and_treat
recursive subroutine smumps_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 sfac_process_message.F:461