OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
assadd2.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "com_xfem1.inc"
#include "parit_c.inc"
#include "units_c.inc"
#include "task_c.inc"
#include "spmd_c.inc"
#include "scr18_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine assadd2 (addcne, indsky, fsky, fskym, iad_elem, fr_elem, fr_nbcc, procne, niskyfi, addcni2, procni2, iad_i2m, fr_i2m, fr_nbcci2, indskyi2, iadsdp, iadrcp, isendp, irecvp, fthesky, niskyfie, inod_pxfem, addcne_pxfem, procne_pxfem, isendp_pxfem, irecvp_pxfem, iadsdp_pxfem, iadrcp_pxfem, fr_nbcc1, inod_crkxfem, addcne_crkxfem, procne_crkxfem, isendp_crkxfem, irecvp_crkxfem, iadsdp_crkxfem, iadrcp_crkxfem, condnsky, glob_therm)
subroutine assinit (addcne, iad_elem, fr_elem, procne, lisendp, lirecvp)
subroutine assinit_pxfem (addcne, inod, iad_elem, fr_elem, procne, lisendp, lirecvp)
subroutine assinit_crkxfem (addcne_crkxfem, inod_crkxfem, iad_elem, fr_elem, procne, lisendp, lirecvp)

Function/Subroutine Documentation

◆ assadd2()

subroutine assadd2 ( integer, dimension(*) addcne,
integer, dimension(*) indsky,
fsky,
fskym,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(2,*) fr_nbcc,
integer, dimension(*) procne,
integer, dimension(*) niskyfi,
integer, dimension(*) addcni2,
integer, dimension(*) procni2,
integer, dimension(*) iad_i2m,
integer, dimension(*) fr_i2m,
integer, dimension(2,*) fr_nbcci2,
integer, dimension(*) indskyi2,
integer, dimension(*) iadsdp,
integer, dimension(*) iadrcp,
integer, dimension(*) isendp,
integer, dimension(*) irecvp,
fthesky,
integer, dimension(*) niskyfie,
integer, dimension(*) inod_pxfem,
integer, dimension(*) addcne_pxfem,
integer, dimension(*) procne_pxfem,
integer, dimension(*) isendp_pxfem,
integer, dimension(*) irecvp_pxfem,
integer, dimension(*) iadsdp_pxfem,
integer, dimension(*) iadrcp_pxfem,
integer, dimension(2,*) fr_nbcc1,
integer, dimension(*) inod_crkxfem,
integer, dimension(*) addcne_crkxfem,
integer, dimension(*) procne_crkxfem,
integer, dimension(*) isendp_crkxfem,
integer, dimension(*) irecvp_crkxfem,
integer, dimension(*) iadsdp_crkxfem,
integer, dimension(*) iadrcp_crkxfem,
condnsky,
type (glob_therm_), intent(inout) glob_therm )

Definition at line 34 of file assadd2.F.

43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 use glob_therm_mod
47 use my_alloc_mod
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com01_c.inc"
56#include "com04_c.inc"
57#include "com08_c.inc"
58#include "com_xfem1.inc"
59#include "parit_c.inc"
60#include "units_c.inc"
61#include "task_c.inc"
62#include "spmd_c.inc"
63#include "scr18_c.inc"
64 INTEGER MAXBLOC,NBLOC,NBVAL,NBCOL
65 parameter(maxbloc=1000)
66 common/ptmparit/nbloc,nbval(1:maxbloc),nbcol(1:maxbloc)
67 INTEGER MAXBLOCI2,NBLOCI2,NBVALI2,NBCOLI2
68 parameter(maxbloci2=1000)
69 common/ptmpari2/nbloci2,nbvali2(1:maxbloci2),nbcoli2(1:maxbloci2)
70C-----------------------------------------------------------------
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 INTEGER INDSKY(*),ADDCNE(*),IAD_ELEM(2,*),FR_NBCC(2,*),
74 . PROCNE(*),FR_ELEM(*), NISKYFI(*), ADDCNI2(*),NISKYFIE(*),
75 . PROCNI2(*), IAD_I2M(*), FR_I2M(*), FR_NBCCI2(2,*),
76 . INDSKYI2(*), IADSDP(*), IADRCP(*), ISENDP(*), IRECVP(*),
77 . PROCNE_PXFEM(*),ISENDP_PXFEM(*),IRECVP_PXFEM(*),
78 . IADSDP_PXFEM(*),IADRCP_PXFEM(*),FR_NBCC1(2,*),
79 . ADDCNE_PXFEM(*),INOD_PXFEM(*),ADDCNE_CRKXFEM(*),
80 . INOD_CRKXFEM(*),PROCNE_CRKXFEM(*),ISENDP_CRKXFEM(*),
81 . IRECVP_CRKXFEM(*),IADSDP_CRKXFEM(*),IADRCP_CRKXFEM(*)
82 my_real
83 . fsky(8,lsky),fskym(lsky),fthesky(lsky),condnsky(lsky)
84 type (glob_therm_) ,intent(inout) :: glob_therm
85C-----------------------------------------------
86C L o c a l V a r i a b l e s
87C-----------------------------------------------
88 INTEGER I, J, N, K, L, NC1, NC, LOC_PROC, NOD, CC, lsd, lrc,
89 . WORK(70000), LSD1,LRC1,NOD1,XFEM_REM_COUNT
90 INTEGER,DIMENSION(:),ALLOCATABLE :: INDEX
91C-----------------------------------------------
92 CALL my_alloc(index,2*numnod)
93C-----------------------------------------------
94C Init a ZERO FORCES NODALES
95C-----------------------------------------------
96 nisky = 0
97 DO n = 1, ninter
98 niskyfi(n) = 0
99 niskyfie(n) = 0
100 ENDDO
101 DO k=1,8
102 DO i = 1, lsky
103 fsky(k,i)=zero
104 ENDDO
105 ENDDO
106C
107C
108 IF (glob_therm%ITHERM_FE > 0 ) THEN
109 DO i=1,lsky
110 fthesky(i) = zero
111 ENDDO
112 ENDIF
113C
114 IF (glob_therm%NODADT_THERM > 0 ) THEN
115 DO i=1,lsky
116 condnsky(i) = zero
117 ENDDO
118 ENDIF
119C
120 IF (n2d == 0 .AND. iale+ieuler + glob_therm%ITHERM > 0) THEN
121 DO i = 1, lsky
122 fskym(i)=zero
123 ENDDO
124 ENDIF
125C
126C spmd cne et addcne deja obtenus
127C iadx deja calcule dans RADIOSS Starter
128C
129C-----------------------------------------------
130C Calcul des tailles des comms elementaires
131C-----------------------------------------------
132 DO i = 1, nspmd+1
133 fr_nbcc(1,i) = 0
134 fr_nbcc(2,i) = 0
135 ENDDO
136 IF(iplyxfem > 0 ) THEN
137 DO i = 1, nspmd+1
138 fr_nbcc1(1,i) = 0
139 fr_nbcc1(2,i) = 0
140 ENDDO
141 ENDIF
142C
143 IF(icrack3d > 0 .AND. nspmd > 1)THEN
144 DO i = 1, nspmd+1
145 fr_nbcc1(1,i) = 0
146 fr_nbcc1(2,i) = 0
147 ENDDO
148 ENDIF
149C
150 loc_proc = ispmd+1
151C
152 lsd = 1
153 lrc = 1
154C
155 lsd1 = 1
156 lrc1 = 1
157 IF(iplyxfem == 0 .AND. icrack3d == 0) THEN
158 DO i = 1, nspmd
159 iadsdp(i)=lsd
160 iadrcp(i)=lrc
161 IF(i/=loc_proc) THEN
162 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
163 nod = fr_elem(j)
164 DO cc = addcne(nod),addcne(nod+1)-1
165 IF(procne(cc)==loc_proc) THEN
166 fr_nbcc(1,i) = fr_nbcc(1,i)+1
167 isendp(lsd) = cc
168 lsd = lsd + 1
169 ELSEIF(procne(cc)==i) THEN
170 fr_nbcc(2,i) = fr_nbcc(2,i)+1
171 irecvp(lrc) = cc
172 lrc = lrc + 1
173 ENDIF
174 ENDDO
175 ENDDO
176 ENDIF
177 ENDDO
178C
179 iadsdp(nspmd+1)=lsd
180 iadrcp(nspmd+1)=lrc
181 ELSE IF (iplyxfem > 0) THEN
182 DO i = 1, nspmd
183 iadsdp(i)=lsd
184 iadrcp(i)=lrc
185C
186 iadsdp_pxfem(i)=lsd1
187 iadrcp_pxfem(i)=lrc1
188 IF(i/=loc_proc) THEN
189 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
190 nod = fr_elem(j)
191 DO cc = addcne(nod),addcne(nod+1)-1
192 IF(procne(cc)==loc_proc) THEN
193 fr_nbcc(1,i) = fr_nbcc(1,i)+1
194 isendp(lsd) = cc
195 lsd = lsd + 1
196 ELSEIF(procne(cc)==i) THEN
197 fr_nbcc(2,i) = fr_nbcc(2,i)+1
198 irecvp(lrc) = cc
199 lrc = lrc + 1
200 ENDIF
201 ENDDO
202 nod1 = inod_pxfem(nod)
203 IF(nod1 > 0 ) THEN
204 DO cc = addcne_pxfem(nod1),addcne_pxfem(nod1+1)-1
205 IF(procne_pxfem(cc)==loc_proc) THEN
206 fr_nbcc1(1,i) = fr_nbcc1(1,i)+1
207 isendp_pxfem(lsd1) = cc
208 lsd1 = lsd1 + 1
209 ELSEIF(procne_pxfem(cc)==i) THEN
210 fr_nbcc1(2,i) = fr_nbcc1(2,i)+1
211 irecvp_pxfem(lrc1) = cc
212 lrc1 = lrc1 + 1
213 ENDIF
214 ENDDO
215 ENDIF
216 ENDDO
217 ENDIF
218 ENDDO
219 iadsdp(nspmd+1)=lsd
220 iadrcp(nspmd+1)=lrc
221C
222 iadsdp_pxfem(nspmd+1)=lsd1
223 iadrcp_pxfem(nspmd+1)=lrc1
224c
225 ELSE IF (icrack3d > 0 .AND. nspmd > 1) THEN
226 DO i = 1, nspmd
227 iadsdp(i)=lsd
228 iadrcp(i)=lrc
229C
230 iadsdp_crkxfem(i)=lsd1
231 iadrcp_crkxfem(i)=lrc1
232 IF (i /= loc_proc) THEN
233 DO j = iad_elem(1,i),iad_elem(1,i+1)-1
234 nod = fr_elem(j)
235 DO cc = addcne(nod),addcne(nod+1)-1
236 IF (procne(cc) == loc_proc) THEN
237 fr_nbcc(1,i) = fr_nbcc(1,i)+1
238 isendp(lsd) = cc
239 lsd = lsd + 1
240 ELSEIF (procne(cc) == i) THEN
241 fr_nbcc(2,i) = fr_nbcc(2,i)+1
242 irecvp(lrc) = cc
243 lrc = lrc + 1
244 ENDIF
245 ENDDO
246c---
247 nod1 = inod_crkxfem(nod)
248 IF (nod1 > 0 ) THEN
249 xfem_rem_count = 0
250 DO cc = addcne_crkxfem(nod1),addcne_crkxfem(nod1+1)-1
251 IF (procne_crkxfem(cc) == i) xfem_rem_count =
252 . xfem_rem_count+1
253 ENDDO
254c
255 IF (xfem_rem_count /= 0) THEN
256 DO cc = addcne_crkxfem(nod1),addcne_crkxfem(nod1+1)-1
257 IF (procne_crkxfem(cc)==loc_proc) THEN
258 fr_nbcc1(1,i) = fr_nbcc1(1,i)+1
259 isendp_crkxfem(lsd1) = cc
260 lsd1 = lsd1 + 1
261 ELSEIF (procne_crkxfem(cc)==i) THEN
262 fr_nbcc1(2,i) = fr_nbcc1(2,i)+1
263 irecvp_crkxfem(lrc1) = cc
264 lrc1 = lrc1 + 1
265 ENDIF
266 ENDDO
267 ENDIF
268c
269 ENDIF
270c---
271 ENDDO ! loop over frontier nodes
272 ENDIF ! I /= LOC_PROC
273 ENDDO ! I = 1, NSPMD
274 iadsdp(nspmd+1)=lsd
275 iadrcp(nspmd+1)=lrc
276C
277 iadsdp_crkxfem(nspmd+1)=lsd1
278 iadrcp_crkxfem(nspmd+1)=lrc1
279 ENDIF
280C-------------------------------------
281 DO i = 1, nspmd
282 fr_nbcc(1,nspmd+1) = fr_nbcc(1,nspmd+1) + fr_nbcc(1,i)
283 fr_nbcc(2,nspmd+1) = fr_nbcc(2,nspmd+1) + fr_nbcc(2,i)
284 ENDDO
285C
286 IF(iplyxfem > 0) THEN
287 DO i = 1, nspmd
288 fr_nbcc1(1,nspmd+1) = fr_nbcc1(1,nspmd+1) + fr_nbcc1(1,i)
289 fr_nbcc1(2,nspmd+1) = fr_nbcc1(2,nspmd+1) + fr_nbcc1(2,i)
290 ENDDO
291 ENDIF
292C
293 IF(icrack3d > 0 .AND. nspmd > 1)THEN
294 DO i = 1, nspmd
295 fr_nbcc1(1,nspmd+1) = fr_nbcc1(1,nspmd+1) + fr_nbcc1(1,i)
296 fr_nbcc1(2,nspmd+1) = fr_nbcc1(2,nspmd+1) + fr_nbcc1(2,i)
297 ENDDO
298 ENDIF
299C-----------------------------------------------
300C Optimisation vectorielle de asspar4
301C-----------------------------------------------
302 IF (ivector==1) THEN
303C index : 2*numnod
304C indsky : numnod
305 DO n = 1, numnod
306 indsky(n) = addcne(n+1) - addcne(n)
307 index(n) = n
308 ENDDO
309 CALL my_orders(0,work,indsky,index,numnod,1)
310 DO n = 1, numnod
311 indsky(n) = index(n)
312 ENDDO
313C
314C reperage des blocs
315C
316 nc1 = -1
317 i = 1
318 nbloc = 0
319 DO WHILE (i<=numnod)
320 n = indsky(i)
321 nc = addcne(n+1)-addcne(n)
322 IF(nc==nc1) THEN
323 nbval(nbloc) = nbval(nbloc)+1
324 ELSE
325 nc1 = nc
326 nbloc = nbloc+1
327 IF (nbloc>maxbloc) THEN
328 WRITE(iout,*)
329 . ' **ERROR**: MEMORY PROBLEM IN PARITH OPTION'
330 WRITE(istdo,*)
331 . ' **ERROR**: MEMORY PROBLEM IN PARITH OPTION'
332 tstop=zero
333 RETURN
334 ENDIF
335 nbval(nbloc) = 1
336 nbcol(nbloc) = nc
337 ENDIF
338 i = i+1
339 ENDDO
340C fin ivector=1
341 ENDIF
342C
343C Partie Interface type 2
344C
345 DO i = 1, nspmd+1
346 fr_nbcci2(1,i) = 0
347 fr_nbcci2(2,i) = 0
348 ENDDO
349
350 IF(i2nsnt>0) THEN
351C-----------------------------------------------
352C Calcul des tailles des comms elementaires
353C-----------------------------------------------
354C
355 loc_proc = ispmd+1
356 DO i = 1, nspmd
357 IF(i/=loc_proc) THEN
358 DO j=iad_i2m(i),iad_i2m(i+1)-1
359 nod = fr_i2m(j)
360 DO cc = addcni2(nod),addcni2(nod+1)-1
361 IF(procni2(cc)==loc_proc) THEN
362 fr_nbcci2(1,i) = fr_nbcci2(1,i)+1
363C ELSE
364 ELSEIF(procni2(cc)==i) THEN
365 fr_nbcci2(2,i) = fr_nbcci2(2,i)+1
366 ENDIF
367 ENDDO
368 ENDDO
369 ENDIF
370 ENDDO
371C
372 DO i = 1, nspmd
373 fr_nbcci2(1,nspmd+1) = fr_nbcci2(1,nspmd+1)+fr_nbcci2(1,i)
374 fr_nbcci2(2,nspmd+1) = fr_nbcci2(2,nspmd+1)+fr_nbcci2(2,i)
375 ENDDO
376C-----------------------------------------------
377C Optimisation vectorielle de asspari2
378C-----------------------------------------------
379 IF (ivector==1) THEN
380C index : 2*numnod
381C indskyi2 : numnod
382 DO n = 1, numnod
383 indskyi2(n) = addcni2(n+1) - addcni2(n)
384 index(n) = n
385 ENDDO
386 CALL my_orders(0,work,indskyi2,index,numnod,1)
387 DO n = 1, numnod
388 indskyi2(n) = index(n)
389 ENDDO
390C
391C reperage des blocs
392C
393 nc1 = -1
394 i = 1
395 nbloci2 = 0
396 DO WHILE (i<=numnod)
397 n = indskyi2(i)
398 nc = addcni2(n+1)-addcni2(n)
399 IF(nc==nc1) THEN
400 nbvali2(nbloci2) = nbvali2(nbloci2)+1
401 ELSE
402 nc1 = nc
403 nbloci2 = nbloci2+1
404 IF (nbloci2>maxbloc) THEN
405 WRITE(iout,*)
406 . ' **ERROR**: MEMORY PROBLEM IN PARITH OPTION'
407 WRITE(istdo,*)
408 . ' **ERROR**: MEMORY PROBLEM IN PARITH OPTION'
409 tstop=zero
410 RETURN
411 ENDIF
412 nbvali2(nbloci2) = 1
413 nbcoli2(nbloci2) = nc
414 ENDIF
415 i = i+1
416 ENDDO
417C fin ivector=1
418 ENDIF
419C fin interface type I2NSNT > 0
420 END IF
421C
422 DEALLOCATE(index)
423 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82

◆ assinit()

subroutine assinit ( integer, dimension(*) addcne,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) procne,
integer lisendp,
integer lirecvp )

Definition at line 431 of file assadd2.F.

433C-----------------------------------------------
434C I m p l i c i t T y p e s
435C-----------------------------------------------
436#include "implicit_f.inc"
437C-----------------------------------------------
438C C o m m o n B l o c k s
439C-----------------------------------------------
440#include "com01_c.inc"
441#include "parit_c.inc"
442#include "task_c.inc"
443C-----------------------------------------------------------------
444C D u m m y A r g u m e n t s
445C-----------------------------------------------
446 INTEGER ADDCNE(*),IAD_ELEM(2,*),
447 . PROCNE(*),FR_ELEM(*), LISENDP, LIRECVP
448C-----------------------------------------------
449C L o c a l V a r i a b l e s
450C-----------------------------------------------
451 INTEGER I, J, LOC_PROC, NOD, CC, LSD, LRC
452C-----------------------------------------------
453C Calcul des tailles des comms optimis\E9es parith/on
454C-----------------------------------------------
455 IF(nspmd>0.AND.iparit>0)THEN
456 loc_proc = ispmd+1
457C
458 lsd = 0
459 lrc = 0
460 DO i = 1, nspmd
461 IF(i/=loc_proc) THEN
462 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
463 nod = fr_elem(j)
464 DO cc = addcne(nod),addcne(nod+1)-1
465 IF(procne(cc)==loc_proc) THEN
466 lsd = lsd + 1
467 ELSEIF(procne(cc)==i) THEN
468 lrc = lrc + 1
469 ENDIF
470 ENDDO
471 ENDDO
472 ENDIF
473 ENDDO
474 lisendp = lsd
475 lirecvp = lrc
476 ELSE
477 lisendp = 0
478 lirecvp = 0
479 END IF
480C
481 RETURN

◆ assinit_crkxfem()

subroutine assinit_crkxfem ( integer, dimension(*) addcne_crkxfem,
integer, dimension(*) inod_crkxfem,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) procne,
integer lisendp,
integer lirecvp )

Definition at line 548 of file assadd2.F.

550C-----------------------------------------------
551C I m p l i c i t T y p e s
552C-----------------------------------------------
553#include "implicit_f.inc"
554C-----------------------------------------------
555C C o m m o n B l o c k s
556C-----------------------------------------------
557#include "com01_c.inc"
558#include "parit_c.inc"
559#include "task_c.inc"
560C-----------------------------------------------------------------
561C D u m m y A r g u m e n t s
562C-----------------------------------------------
563 INTEGER ADDCNE_CRKXFEM(*),IAD_ELEM(2,*),INOD_CRKXFEM(*),
564 . PROCNE(*),FR_ELEM(*), LISENDP, LIRECVP
565C-----------------------------------------------
566C L o c a l V a r i a b l e s
567C-----------------------------------------------
568 INTEGER I, J, LOC_PROC, NOD, CC, LSD, LRC,N,
569 . LENR,K
570C-----------------------------------------------
571C Calcul des tailles des comms optimis\E9es parith/on
572C-----------------------------------------------
573 IF(nspmd>0.AND.iparit>0)THEN
574 loc_proc = ispmd+1
575C
576 lsd = 0
577 lrc = 0
578 DO i = 1, nspmd
579 IF(i/=loc_proc) THEN
580 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
581 n = fr_elem(j)
582 nod = inod_crkxfem(n)
583 IF(nod > 0 )THEN ! check if node is Xfem sur proc i /= proc_loc
584 DO cc = addcne_crkxfem(nod),addcne_crkxfem(nod+1)-1
585 IF(procne(cc)==loc_proc) THEN
586 lsd = lsd + 1 ! long de frontiere d'echange pour send
587 ELSEIF(procne(cc)==i) THEN
588 lrc = lrc + 1 ! long de frontiere d'echange pour rcv
589 ENDIF
590 ENDDO
591 ENDIF
592 ENDDO
593 ENDIF
594 ENDDO
595 lisendp = lsd
596 lirecvp = lrc
597 ELSE
598 lisendp = 0
599 lirecvp = 0
600 END IF
601C
602 RETURN

◆ assinit_pxfem()

subroutine assinit_pxfem ( integer, dimension(*) addcne,
integer, dimension(*) inod,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) procne,
integer lisendp,
integer lirecvp )

Definition at line 488 of file assadd2.F.

490C-----------------------------------------------
491C I m p l i c i t T y p e s
492C-----------------------------------------------
493#include "implicit_f.inc"
494C-----------------------------------------------
495C C o m m o n B l o c k s
496C-----------------------------------------------
497#include "com01_c.inc"
498#include "parit_c.inc"
499#include "task_c.inc"
500C-----------------------------------------------------------------
501C D u m m y A r g u m e n t s
502C-----------------------------------------------
503 INTEGER ADDCNE(*),IAD_ELEM(2,*),INOD(*),
504 . PROCNE(*),FR_ELEM(*), LISENDP, LIRECVP
505C-----------------------------------------------
506C L o c a l V a r i a b l e s
507C-----------------------------------------------
508 INTEGER I, J, LOC_PROC, NOD, CC, LSD, LRC,N
509C-----------------------------------------------
510C Calcul des tailles des comms optimis\E9es parith/on
511C-----------------------------------------------
512 IF(nspmd>0.AND.iparit>0)THEN
513 loc_proc = ispmd+1
514C
515 lsd = 0
516 lrc = 0
517 DO i = 1, nspmd
518 IF(i/=loc_proc) THEN
519 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
520 n = fr_elem(j)
521 nod = inod(n)
522 IF(nod > 0 )THEN
523 DO cc = addcne(nod),addcne(nod+1)-1
524 IF(procne(cc)==loc_proc) THEN
525 lsd = lsd + 1
526 ELSEIF(procne(cc)==i) THEN
527 lrc = lrc + 1
528 ENDIF
529 ENDDO
530 ENDIF
531 ENDDO
532 ENDIF
533 ENDDO
534 lisendp = lsd
535 lirecvp = lrc
536 ELSE
537 lisendp = 0
538 lirecvp = 0
539 END IF
540C
541 RETURN