34 IMPLICIT NONE
35 INTEGER MTYPE
36 INTEGER(8), intent(in) :: LA
37 INTEGER(8), intent(in) :: LWC
38 INTEGER, intent(in) :: N,LIW,LIWW,LPOOL
39 INTEGER, intent(in) :: SLAVEF,MYLEAF,MYROOT,COMM,MYID
40 INTEGER KEEP( 500 )
41 INTEGER(8) KEEP8(150)
42 DOUBLE PRECISION, INTENT(INOUT) :: DKEEP(230)
43 INTEGER PROCNODE_STEPS(KEEP(28))
44 INTEGER NE_STEPS(KEEP(28))
45 INTEGER IPOOL(LPOOL)
46 INTEGER LPANEL_POS
47 INTEGER PANEL_POS(LPANEL_POS)
48 INTEGER ICNTL(60), INFO(80)
49 INTEGER PTRIST((28)),
50 & PTRICB(KEEP(28))
51 INTEGER(8) :: PTRACB(KEEP(28))
52 INTEGER(8) :: PTRFAC((28))
53 INTEGER NRHS
54 COMPLEX(kind=8) A(LA), W(LWC)
55 COMPLEX(kind=8) W2(KEEP(133))
56 INTEGER IW(LIW),IWCB(LIWW)
57 INTEGER STEP(N), FRERE(KEEP(28)),DAD(KEEP(28)),FILS(N)
58 INTEGER LBUFR, LBUFR_BYTES
59 INTEGER BUFR(LBUFR)
60 INTEGER ISTEP_TO_INIV2(KEEP(71)),
61 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
62 INTEGER LRHSCOMP, POSINRHSCOMP_BWD(N)
63 COMPLEX(kind=8) RHSCOMP(LRHSCOMP,NRHS)
64 INTEGER(8), intent(in) :: LRHS_ROOT
65 COMPLEX(kind=8) RHS_ROOT( LRHS_ROOT )
66 LOGICAL, INTENT(in) :: PRUN_BELOW
67 INTEGER, intent(in) :: SIZE_TO_PROCESS
68 LOGICAL, intent(in) :: TO_PROCESS(SIZE_TO_PROCESS)
69 LOGICAL, intent(in) :: DO_NBSPARSE
70 INTEGER, intent(in) :: LRHS_BOUNDS
71 INTEGER, intent(in) :: RHS_BOUNDS()
72 LOGICAL, intent(in) :: FROM_PP
73 INTEGER, INTENT( in ) :: LL0_OMP_MAPPING, LL0_OMP_FACTORS
74 INTEGER, INTENT( in ) :: L0_OMP_MAPPING( LL0_OMP_MAPPING )
75 TYPE (ZMUMPS_L0OMPFAC_T), INTENT(IN) ::
76 & L0_OMP_FACTORS(LL0_OMP_FACTORS)
77 include 'mpif.h'
78 INCLUDE 'mumps_tags.h'
79 LOGICAL FLAG
80 COMPLEX(kind=8), DIMENSION(:), POINTER :: A_PTR
81 INTEGER(8) :: LA_PTR
82 INTEGER :: UNDERL0MAP
83 INTEGER(8) :: POSWCB, PLEFTW
84 INTEGER POSIWCB
85 INTEGER NBFINF
86 INTEGER INODE
87 INTEGER III,IIPOOL,MYLEAF_LEFT
88 LOGICAL BLOQ
89 INTEGER DUMMY(1)
90 LOGICAL :: ERROR_WAS_BROADCASTED, DO_MCAST2_TERMBWD
91 LOGICAL :: ALLOW_OTHERS_TO_LEAVE
92 LOGICAL, DIMENSION(:), ALLOCATABLE :: DEJA_SEND
93 INTEGER :: allocok
94 DUMMY(1)=0
95 KEEP(266)=0
96 ALLOCATE(DEJA_SEND( 0:SLAVEF-1 ), stat=allocok)
97.ne. if(allocok0) then
98 WRITE(6,*) ' allocation error of deja_send in '
100 INFO(1)=-13
101 INFO(2)=SLAVEF
102 endif
103 CALL MUMPS_PROPINFO( ICNTL, INFO, COMM, MYID )
104.LT. IF ( INFO(1) 0 ) GOTO 340
105 PLEFTW = 1_8
106 POSIWCB = LIWW
107 POSWCB = LWC
108 III = 1
109 IIPOOL = MYROOT + 1
110 MYLEAF_LEFT = MYLEAF
111 NBFINF = SLAVEF
112.EQ..AND. ALLOW_OTHERS_TO_LEAVE = ( MYLEAF_LEFT 0
113.EQ. & KEEP(31) 0 )
114.OR. ALLOW_OTHERS_TO_LEAVE = ALLOW_OTHERS_TO_LEAVE
115.EQ. & KEEP(31) 1
116 IF (ALLOW_OTHERS_TO_LEAVE) THEN
117 CALL ZMUMPS_MCAST2(DUMMY, 1, MPI_INTEGER, MYID, COMM, TERMBWD,
118 & SLAVEF, KEEP)
119 NBFINF = NBFINF - 1
120.EQ..AND..EQ. IF (NBFINF 0 MYLEAF_LEFT 0) THEN
121 GOTO 340
122 ENDIF
123 ENDIF
124 ERROR_WAS_BROADCASTED = .FALSE.
125 DO_MCAST2_TERMBWD = .FALSE.
126.NE..OR..NE. DO WHILE ( NBFINF 0 MYLEAF_LEFT 0 )
127.EQ. BLOQ = ( III IIPOOL )
128 CALL ZMUMPS_BACKSLV_RECV_AND_TREAT( BLOQ, FLAG, BUFR, LBUFR,
129 & LBUFR_BYTES, MYID, SLAVEF, COMM,
130 & N, IWCB, LIWW, POSIWCB,
131 & W, LWC, POSWCB,
132 & IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
133 & IPOOL, LPOOL, PANEL_POS, LPANEL_POS,
134 & STEP, FRERE, FILS, PROCNODE_STEPS,
135 & PLEFTW, KEEP,KEEP8, DKEEP,
136 & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAF_LEFT,
137 & NRHS, MTYPE,
138 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_BWD
139 & , PRUN_BELOW, TO_PROCESS, SIZE_TO_PROCESS
140 & , FROM_PP
141 & )
142.LT. IF ( INFO(1) 0 ) GOTO 340
143.NOT. IF ( FLAG ) THEN
144.NE. IF (III IIPOOL) THEN
145 INODE = IPOOL(IIPOOL-1)
146 IIPOOL = IIPOOL - 1
147.GT. IF (KEEP(400) 0 ) THEN
148 UNDERL0MAP = L0_OMP_MAPPING(STEP(INODE))
149 ELSE
150 UNDERL0MAP = 0
151 ENDIF
152.EQ..OR..GT. IF (UNDERL0MAP 0 KEEP(201)0) THEN
153 CALL ZMUMPS_SET_STATIC_PTR(A)
154 CALL ZMUMPS_GET_TMP_PTR(A_PTR)
155 LA_PTR = LA
156 ELSE
157 A_PTR => L0_OMP_FACTORS(UNDERL0MAP)%A
158 LA_PTR = L0_OMP_FACTORS(UNDERL0MAP)%LA
159 ENDIF
160 CALL ZMUMPS_SOLVE_NODE_BWD( INODE,
161 & N, IPOOL, LPOOL, IIPOOL, NBFINF,
162 & A_PTR(1), LA_PTR, IW, LIW, W, LWC, NRHS,
163 & POSWCB, PLEFTW, POSIWCB,
164 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_BWD,
165 & PTRICB, PTRACB, IWCB, LIWW, W2,
166 & NE_STEPS, STEP,
167 & FRERE, FILS, PTRIST, PTRFAC,
168 & MYLEAF_LEFT, INFO,
169 & PROCNODE_STEPS, DEJA_SEND,
170 & SLAVEF, COMM, MYID, BUFR, LBUFR, LBUFR_BYTES,
171 & KEEP,KEEP8, DKEEP, RHS_ROOT, LRHS_ROOT, MTYPE,
172 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, PANEL_POS, LPANEL_POS,
173 & PRUN_BELOW, TO_PROCESS, SIZE_TO_PROCESS
174 & , RHS_BOUNDS, LRHS_BOUNDS, DO_NBSPARSE, FROM_PP
175 & , ERROR_WAS_BROADCASTED
176 & , DO_MCAST2_TERMBWD
177 & )
178.LT. IF ( INFO(1) 0 ) THEN
179.NOT. IF ( ERROR_WAS_BROADCASTED) THEN
180.EQ. IF (NBFINF 0 ) THEN
181 CALL ZMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
182 ENDIF
183 ENDIF
184 ENDIF
185 IF (DO_MCAST2_TERMBWD) THEN
186 CALL ZMUMPS_MCAST2( DUMMY, 1, MPI_INTEGER, MYID, COMM,
187 & TERMBWD, SLAVEF, KEEP )
188 ENDIF
189 ENDIF
190 END IF
191 ENDDO
192 340 CONTINUE
193 IF (ALLOCATED(DEJA_SEND)) DEALLOCATE(DEJA_SEND)
194 RETURN
subroutine, public zmumps_get_tmp_ptr(ptr)
subroutine zmumps_set_static_ptr(array)
subroutine zmumps_sol_s(n, a, la, iw, liw, w, lwc, nrhs, rhscomp, lrhscomp, posinrhscomp_bwd, ptricb, ptracb, iwcb, liww, w2, ne_steps, step, frere, dad, fils, ipool, lpool, ptrist, ptrfac, myleaf, myroot, icntl, info, procnode_steps, slavef, comm, myid, bufr, lbufr, lbufr_bytes, keep, keep8, dkeep, rhs_root, lrhs_root, mtype, istep_to_iniv2, tab_pos_in_pere, panel_pos, lpanel_pos, prun_below, to_process, size_to_process, rhs_bounds, lrhs_bounds, do_nbsparse, from_pp, l0_omp_mapping, ll0_omp_mapping, l0_omp_factors, ll0_omp_factors)
1.15.0