OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
w_seatbelts.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
25!||====================================================================
26!|| w_seatbelts ../starter/source/restart/ddsplit/w_seatbelts.F
27!||--- called by ------------------------------------------------------
28!|| ddsplit ../starter/source/restart/ddsplit/ddsplit.F
29!||--- calls -----------------------------------------------------
30!|| nlocal ../starter/source/spmd/node/ddtools.F
31!||--- uses -----------------------------------------------------
32!||====================================================================
33 SUBROUTINE w_seatbelts(LEN_IA,LEN_AM,P,NODLOCAL,N_ANCHOR_REMOTE_L,
34 . N_ANCHOR_REMOTE_SEND_L,ANCHOR_REMOTE_L,ANCHOR_REMOTE_SEND_L)
35C---------------------------------------------
36 USE seatbelt_mod
37C---------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41#include "param_c.inc"
42#include "com01_c.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER LEN_AM,LEN_IA,P,NODLOCAL(*),N_ANCHOR_REMOTE_L,N_ANCHOR_REMOTE_SEND_L
47 TYPE(seatbelt_remote_nodes_struct) ANCHOR_REMOTE_L,ANCHOR_REMOTE_SEND_L
48C-----------------------------------------------
49C E x t e r n a l F u n c t i o n s
50C-----------------------------------------------
51 INTEGER NLOCAL
52 EXTERNAL nlocal
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 INTEGER I,J,K,OPTIONAL_NODE,L_TABLE,NPT
57C-----------------------------------------------
58C
59 DO i = 1, nslipring
60C
61 IF (nlocal(slipring(i)%FRAM(1)%NODE(2),p)==1) THEN
62C
63 CALL write_i_c(slipring(i)%ID, 1)
64 CALL write_i_c(slipring(i)%IDG, 1)
65 CALL write_i_c(slipring(i)%NFRAM, 1)
66 CALL write_i_c(slipring(i)%IFUNC, 4)
67 CALL write_i_c(slipring(i)%SENSID, 1)
68 CALL write_i_c(slipring(i)%FL_FLAG, 1)
69 CALL write_i_c(slipring(i)%RBODY, 1)
70 len_ia = len_ia + 10
71C
72 CALL write_db(slipring(i)%DC, 1)
73 CALL write_db(slipring(i)%A, 1)
74 CALL write_db(slipring(i)%FRIC, 1)
75 CALL write_db(slipring(i)%FAC_D, 3)
76 CALL write_db(slipring(i)%FRICS, 1)
77 CALL write_db(slipring(i)%FAC_S, 3)
78 len_am = len_am + 10
79C
80 DO j=1,slipring(i)%NFRAM
81C
82 CALL write_i_c(slipring(i)%FRAM(j)%UPDATE, 1)
83 CALL write_i_c(nodlocal(slipring(i)%FRAM(j)%ANCHOR_NODE), 1)
84 CALL write_i_c(nodlocal(slipring(i)%FRAM(j)%NODE(1)), 1)
85 CALL write_i_c(nodlocal(slipring(i)%FRAM(j)%NODE(2)), 1)
86 CALL write_i_c(nodlocal(slipring(i)%FRAM(j)%NODE(3)), 1)
87 CALL write_i_c(slipring(i)%FRAM(j)%NODE_NEXT, 3)
88 CALL write_i_c(slipring(i)%FRAM(j)%NODE2_PREV, 1)
89 CALL write_i_c(slipring(i)%FRAM(j)%N_REMOTE_PROC, 1)
90C
91 optional_node = 0
92 IF (slipring(i)%FRAM(j)%ORIENTATION_NODE > 0) THEN
93 optional_node = nodlocal(slipring(i)%FRAM(j)%ORIENTATION_NODE)
94 ENDIF
95 CALL write_i_c(optional_node, 1)
96C
97 CALL write_i_c(slipring(i)%FRAM(j)%STRAND_DIRECTION, 2)
98 CALL write_i_c(slipring(i)%FRAM(j)%LOCKED, 1)
99 len_ia = len_ia + 14
100C
101 CALL write_db(slipring(i)%FRAM(j)%VECTOR, 6)
102 CALL write_db(slipring(i)%FRAM(j)%ORIENTATION_ANGLE, 1)
103 CALL write_db(slipring(i)%FRAM(j)%MATERIAL_FLOW, 1)
104 CALL write_db(slipring(i)%FRAM(j)%MATERIAL_FLOW_OLD, 1)
105 CALL write_db(slipring(i)%FRAM(j)%DFS, 1)
106 CALL write_db(slipring(i)%FRAM(j)%RESIDUAL_LENGTH, 2)
107 CALL write_db(slipring(i)%FRAM(j)%CURRENT_LENGTH, 2)
108 CALL write_db(slipring(i)%FRAM(j)%RINGSLIP, 1)
109 CALL write_db(slipring(i)%FRAM(j)%BETA, 1)
110 CALL write_db(slipring(i)%FRAM(j)%SLIP_FORCE, 3)
111 CALL write_db(slipring(i)%FRAM(j)%PREV_REF_LENGTH, 1)
112 CALL write_db(slipring(i)%FRAM(j)%INTVAR_STR1, 8)
113 CALL write_db(slipring(i)%FRAM(j)%INTVAR_STR2, 8)
114 len_am = len_am + 35
115C
116 ENDDO
117C
118 ENDIF
119C
120 ENDDO
121C
122 DO i = 1, nretractor
123C
124 IF (nlocal(retractor(i)%NODE(2),p)==1) THEN
125 CALL write_i_c(retractor(i)%ID, 1)
126 CALL write_i_c(retractor(i)%IDG, 1)
127 CALL write_i_c(retractor(i)%UPDATE, 1)
128 CALL write_i_c(nodlocal(retractor(i)%ANCHOR_NODE), 1)
129 CALL write_i_c(nodlocal(retractor(i)%NODE(1)), 1)
130 CALL write_i_c(nodlocal(retractor(i)%NODE(2)), 1)
131 CALL write_i_c(retractor(i)%NODE_NEXT, 2)
132 CALL write_i_c(retractor(i)%STRAND_DIRECTION, 1)
133 CALL write_i_c(retractor(i)%IFUNC, 3)
134 CALL write_i_c(retractor(i)%ISENS, 2)
135 CALL write_i_c(retractor(i)%TENS_TYP, 1)
136 CALL write_i_c(retractor(i)%LOCKED, 1)
137 CALL write_i_c(retractor(i)%LOCKED_FREEZE, 1)
138 CALL write_i_c(retractor(i)%PRETENS_ACTIV, 1)
139 CALL write_i_c(retractor(i)%INACTI_NNOD, 1)
140 CALL write_i_c(retractor(i)%INACTI_NNOD_MAX, 1)
141 DO k=1,retractor(i)%INACTI_NNOD
142 CALL write_i_c(nodlocal(retractor(i)%INACTI_NODE(k)), 1)
143 ENDDO
144 CALL write_i_c(retractor(i)%N_REMOTE_PROC, 1)
145 CALL write_i_c(retractor(i)%S_TABLE, 2)
146 len_ia = len_ia + 23 + retractor(i)%INACTI_NNOD
147 CALL write_db(retractor(i)%VECTOR, 3)
148 CALL write_db(retractor(i)%ELEMENT_SIZE, 1)
149 CALL write_db(retractor(i)%FORCE, 1)
150 CALL write_db(retractor(i)%MATERIAL_FLOW, 1)
151 CALL write_db(retractor(i)%RESIDUAL_LENGTH, 1)
152 CALL write_db(retractor(i)%FAC, 4)
153 CALL write_db(retractor(i)%PULLOUT, 1)
154 CALL write_db(retractor(i)%UNLOCK_FORCE, 1)
155 CALL write_db(retractor(i)%LOCK_OFFSET, 1)
156 CALL write_db(retractor(i)%LOCK_PULL, 1)
157 CALL write_db(retractor(i)%LOCK_PULL_SAV, 1)
158 CALL write_db(retractor(i)%LOCK_YIELD_FORCE, 1)
159 CALL write_db(retractor(i)%RINGSLIP, 1)
160 CALL write_db(retractor(i)%PRETENS_TIME, 1)
161 CALL write_db(retractor(i)%PRETENS_PULL, 1)
162 CALL write_db(retractor(i)%PRETENS_PULLMAX, 1)
163 CALL write_db(retractor(i)%RET_FORCE, 1)
164 l_table = 0
165 DO k=1,2
166 IF (retractor(i)%S_TABLE(k) > 0) THEN
167 npt = retractor(i)%S_TABLE(k)
168 l_table = l_table + 2*npt
169 CALL write_db(retractor(i)%TABLE(k)%X(1)%VALUES(1:npt),npt)
170 CALL write_db(retractor(i)%TABLE(k)%Y%VALUES(1:npt),npt)
171 ENDIF
172 ENDDO
173 len_am = len_am + 22 + l_table
174 ENDIF
175C
176 ENDDO
177C
178 IF (n_anchor_remote_l > 0) THEN
179 CALL write_i_c(anchor_remote_l%ADD_PROC, nspmd+1)
180 CALL write_i_c(anchor_remote_l%NODE, n_anchor_remote_l)
181 len_ia = len_ia + nspmd + 1 + n_anchor_remote_l
182 ENDIF
183C
184 IF (n_anchor_remote_send_l > 0) THEN
185 CALL write_i_c(anchor_remote_send_l%ADD_PROC, nspmd+1)
186 CALL write_i_c(anchor_remote_send_l%NODE, n_anchor_remote_send_l)
187 len_ia = len_ia + nspmd + 1 + n_anchor_remote_send_l
188 ENDIF
189C
190 IF (p ==1) THEN
192 len_ia = len_ia + 1
193 IF ((nspmd > 1).AND.(nseatbelt_th_proc > 0)) THEN
194 DO i=1,nseatbelt_th_proc
195 CALL write_i_c(seatbelt_th_exch(i)%ID_PROC, 1)
196 CALL write_i_c(seatbelt_th_exch(i)%ADD_PROC, 1)
197 CALL write_i_c(seatbelt_th_exch(i)%NSLIPRING, 1)
198 CALL write_i_c(seatbelt_th_exch(i)%NRETRACTOR, 1)
199 len_ia = len_ia + 4
200 ENDDO
201 ENDIF
202 ENDIF
203C
204! --------------------------------------
205 RETURN
206 END
integer nseatbelt_th_proc
type(retractor_struct), dimension(:), allocatable retractor
type(seatbelt_th_exch_struct), dimension(:), allocatable seatbelt_th_exch
type(slipring_struct), dimension(:), allocatable slipring
subroutine w_seatbelts(len_ia, len_am, p, nodlocal, n_anchor_remote_l, n_anchor_remote_send_l, anchor_remote_l, anchor_remote_send_l)
Definition w_seatbelts.F:35
subroutine write_db(a, n)
Definition write_db.F:140
void write_i_c(int *w, int *len)