OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
tshcdcom_dim.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine tshcdcom_dim (ienunl, fr_elem, iad_elem, nbdds, nbddr, isend, irecv)

Function/Subroutine Documentation

◆ tshcdcom_dim()

subroutine tshcdcom_dim ( integer, dimension(2,*) ienunl,
integer, dimension(*) fr_elem,
integer, dimension(2,*) iad_elem,
integer nbdds,
integer nbddr,
integer, dimension(*) isend,
integer, dimension(*) irecv )

Definition at line 30 of file tshcdcom_dim.F.

32C-----------------------------------------------
33C M o d u l e s
34C-----------------------------------------------
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C C o m m o n B l o c k s
41C-----------------------------------------------
42#include "com01_c.inc"
43#include "com04_c.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 INTEGER IENUNL(2,*),FR_ELEM(*),IAD_ELEM(2,*),NBDDS,NBDDR,
48 . IRECV(*),ISEND(*)
49C-----------------------------------------------
50C L o c a l V a r i a b l e s
51C-----------------------------------------------
52 INTEGER I,J,N,IP,ITAGS(NUMNOD),LEN
53C=======================================================================
54 itags(1:numnod)=0
55 DO i = 1, ntsheg
56 n = ienunl(1,i)
57 itags(n) = i
58 n = ienunl(2,i)
59 itags(n) = i
60 END DO
61C--------
62 nbdds = 0
63 DO ip = 1,nspmd
64 DO j= iad_elem(1,ip),iad_elem(1,ip+1)-1
65 n = fr_elem(j)
66 IF (itags(n)>0) THEN
67 nbdds = nbdds + 1
68 isend(j) = 1
69 END IF
70 END DO
71 END DO
72 len = iad_elem(1,nspmd+1)-iad_elem(1,1)
73 CALL spmd_exch_tag_tsh(iad_elem ,fr_elem ,isend,irecv ,len)
74 nbddr = 0
75 DO ip = 1,nspmd
76 DO j= iad_elem(1,ip),iad_elem(1,ip+1)-1
77 IF (irecv(j)>0) nbddr = nbddr + 1
78 END DO
79 END DO
80C
81 RETURN
subroutine spmd_exch_tag_tsh(iad_elem, fr_elem, isend, irecv, len)