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.EQ. IF (SLAVEF1) RETURN
837.NOT..AND..NOT. IF ( CLEAN_COMM_NODES 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.NOT. IF ( 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.NOT. IF ( 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.EQ. IF (COMM_EFF 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.LE. IF (MSGLEN_LOC 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.EQ..AND. IF (TOTAL_SEND_MINUS_RECV266 0
914.EQ. & TOTAL_SEND_MINUS_RECV267 0) THEN
915 EXIT
916 ENDIF
917 ENDIF
918 ENDDO
919 RETURN

◆ 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
mpi_get_count
subroutine mpi_get_count(status, datatype, cnt, ierr)
Definition mpi.f:296
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.LT. IF ( IFLAG 0 ) GO to 500
172.EQ..OR. ELSEIF ( MSGTAG BLOC_FACTO
173.EQ. & MSGTAG 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.EQ. ELSEIF ( MSGTAG 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.EQ. ELSEIF ( MSGTAG 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.EQ. ELSEIF ( MSGTAG 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.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 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.LT. IF ( IFLAG 0 ) GO TO 100
276.EQ. ELSE IF ( MSGTAG 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.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 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.LT. IF ( IFLAG 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.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 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.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 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.EQ. ELSE IF ( MSGTAG 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.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 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.LT. IF ( IFLAG 0 ) GO TO 500
412.EQ. ELSE IF ( MSGTAG UPDATE_LOAD ) THEN
413 WRITE(*,*) "internal error 3 in smumps_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 SMUMPS_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 SMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
440 RETURN
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_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_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_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_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
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
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
mpi_iprobe
subroutine mpi_iprobe(source, tag, comm, flag, status, ierr)
Definition mpi.f:360
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