OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s10edg_rlink.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| s10edg_rlink ../starter/source/elements/solid/solide10/s10edg_rlink.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| intab ../starter/source/interfaces/inter3d1/i24tools.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../starter/share/message_module/message_mod.F
32!||====================================================================
33 SUBROUTINE s10edg_rlink(NLINK, NUMLINK,NNLINK,LNLINK,
34 . ITAGND,ICNDS10,ITAB,IPRI,NUMNOD,NS10E)
35C=======================================================================
36 USE message_mod
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 INTEGER, INTENT(IN) :: NLINK,NUMLINK,IPRI,NUMNOD,NS10E
48 INTEGER, DIMENSION(10,NLINK), INTENT (INOUT) :: NNLINK
49 INTEGER, DIMENSION(NUMLINK), INTENT (INOUT) :: LNLINK
50 INTEGER, DIMENSION(NUMNOD), INTENT (IN ) :: ITAB
51 INTEGER, DIMENSION(NUMNOD), INTENT (INOUT) :: ITAGND
52 INTEGER, DIMENSION(3,NS10E), INTENT (IN ) :: ICNDS10
53C REAL
54C-----------------------------------------------
55C External function
56C-----------------------------------------------
57 LOGICAL INTAB
58 EXTERNAL intab
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER I,J,K, N,ND,N1,N2,NNEW,ID,IER1,IER2
63 INTEGER IAD,IU,NSL,NS,NN,NNSL
64 LOGICAL IS1,IS2
65 INTEGER, DIMENSION(:), ALLOCATABLE :: LL_TMP
66C REAL
67 k = 0
68 nnew = 0
69 ier1 = 0
70 ier2 = 0
71 DO n=1,nlink
72 nsl = nnlink(1,n)
73 iu = nnlink(2,n)
74 DO i=1,nsl
75 ns = lnlink(k+i)
76 IF (itagnd(ns) /=0 ) THEN
77 id = iabs(itagnd(ns))
78 nd = icnds10(1,id)
79 n1 = icnds10(2,id)
80 n2 = icnds10(3,id)
81 is1 = intab(nsl,lnlink(k+1),n1)
82 is2 = intab(nsl,lnlink(k+1),n2)
83 IF (is1.AND.is2) THEN
84 itagnd(ns) = itagnd(ns) + ns10e
85 nnew = nnew + 1
86 lnlink(k+i) = -lnlink(k+i)
87 ier1 =1
88 IF (ipri>=5)
89 . CALL ancmsg(msgid=1213,
90 . msgtype=msginfo,
91 . anmode=aninfo_blind_1,
92 . c1='RIGID LINK ',
93 . i1=itab(nd),
94 . prmod=msg_cumu)
95 ELSEIF (.NOT.(is1).AND..NOT.(is2)) THEN
96C----error out ND is alone in RLINK
97 CALL ancmsg(msgid=1216,
98 . msgtype=msgerror,
99 . anmode=aninfo_blind_1,
100 . i1=itab(nd),
101 . c1='RIGID LINK ',
102 . i2=iu,
103 . c2='RIGID LINK ')
104 ELSE
105C----removed from INN directly----------
106 nnew = nnew + 1
107 lnlink(k+i) = -lnlink(k+i)
108 ier2 =1
109 IF (ipri>=5)
110 . CALL ancmsg(msgid=1210,
111 . msgtype=msginfo,
112 . anmode=aninfo_blind_1,
113 . c1='RIGID LINK ',
114 . i1=itab(nd),
115 . prmod=msg_cumu)
116 END IF
117 END IF !(ITAGND(NS) /=0 ) THEN
118 END DO
119 IF (ier1 >0.AND.ipri>=5) THEN
120 CALL ancmsg(msgid=1213,
121 . msgtype=msginfo,
122 . anmode=aninfo_blind_1,
123 . c1='RIGID LINK ',
124 . c2='RIGID LINK ',
125 . i1=iu,
126 . prmod=msg_print)
127 END IF
128 IF (ier2 >0.AND.ipri>=5) THEN
129 CALL ancmsg(msgid=1210,
130 . msgtype=msginfo,
131 . anmode=aninfo_blind_1,
132 . c1='RIGID LINK ',
133 . c2='RIGID LINK ',
134 . i1=iu,
135 . prmod=msg_print)
136 END IF
137 k = k + nsl
138 END DO
139C-------nodes removed from
140 IF (nnew>0) THEN
141 ALLOCATE(ll_tmp(numlink))
142 ll_tmp = lnlink
143 k = 0
144 nn = 0
145 DO n=1,nlink
146 nsl = nnlink(1,n)
147 nnsl=0
148 DO i=1,nsl
149 ns = ll_tmp(k+i)
150 IF (ns>0) THEN
151 nnsl = nnsl+1
152 lnlink(nn+i) = ns
153 END IF
154 END DO
155 nnlink(1,n) = nnsl
156 k = k + nsl
157 nn = nn + nnsl
158 END DO
159 DEALLOCATE(ll_tmp)
160 END IF
161C
162 RETURN
163 END
message_mod
Definition message_mod.F:1249
s10edg_rlink
subroutine s10edg_rlink(nlink, numlink, nnlink, lnlink, itagnd, icnds10, itab, ipri, numnod, ns10e)
Definition s10edg_rlink.F:35
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889