OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_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!|| st_qaprint_seatbelts ../starter/source/output/qaprint/st_qaprint_seatbelts.F
25!||--- called by ------------------------------------------------------
26!|| st_qaprint_driver ../starter/source/output/qaprint/st_qaprint_driver.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!||====================================================================
30 SUBROUTINE st_qaprint_seatbelts(ITAB)
31C-----------------------------------------------
32C M o d u l e s
33C-----------------------------------------------
34 USE qa_out_mod
35 USE seatbelt_mod
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "param_c.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 INTEGER, INTENT(IN) :: ITAB(*)
48C--------------------------------------------------
49C L o c a l V a r i a b l e s
50C-----------------------------------------------
51 LOGICAL :: OK_QA
52 CHARACTER (LEN=255) :: VARNAME
53 INTEGER :: I,J
54 DOUBLE PRECISION :: TMPVAL
55C-----------------------------------------------
56C S o u r c e L i n e s
57C-----------------------------------------------
58 IF(nslipring + nretractor == 0)RETURN
59C
60 ok_qa = myqakey('/slipring')
61C
62 IF (OK_QA) THEN
63C
64 DO I = 1, NSLIPRING
65C
66 CALL QAPRINT('slipring id ',SLIPRING(I)%ID,0.0_8)
67 CALL QAPRINT('slipring nfram ',SLIPRING(I)%NFRAM,0.0_8)
68 CALL QAPRINT('slipring fl_flag',SLIPRING(I)%FL_FLAG,0.0_8)
69 CALL QAPRINT('slipring sensid ',SLIPRING(I)%SENSID,0.0_8)
70 CALL QAPRINT('slipring func1 ',SLIPRING(I)%IFUNC(1),0.0_8)
71 CALL QAPRINT('slipring func2 ',SLIPRING(I)%IFUNC(2),0.0_8)
72 CALL QAPRINT('slipring func3 ',slipring(i)%IFUNC(3),0.0_8)
73 CALL qaprint('SLIPRING FUNC4 ',slipring(i)%IFUNC(4),0.0_8)
74C
75 tmpval = slipring(i)%DC
76 CALL qaprint('SLIPRING DC FACTOR ',0,tmpval)
77 tmpval = slipring(i)%A
78 CALL qaprint('slipring a factor ',0,TMPVAL)
79C
80 TMPVAL = SLIPRING(I)%FRIC
81 CALL QAPRINT('slipring fricd ',0,TMPVAL)
82 TMPVAL = SLIPRING(I)%FAC_D(1)
83 CALL QAPRINT('slipring facd1 ',0,TMPVAL)
84 TMPVAL = SLIPRING(I)%FAC_D(2)
85 CALL QAPRINT('slipring facd2 ',0,TMPVAL)
86 TMPVAL = SLIPRING(I)%FAC_D(3)
87 CALL QAPRINT('slipring facd3 ',0,TMPVAL)
88C
89 TMPVAL = SLIPRING(I)%FRICS
90 CALL QAPRINT('slipring frics ',0,TMPVAL)
91 TMPVAL = SLIPRING(I)%FAC_S(1)
92 CALL QAPRINT('slipring facs1 ',0,TMPVAL)
93 TMPVAL = SLIPRING(I)%FAC_S(2)
94 CALL QAPRINT('slipring facs2 ',0,TMPVAL)
95 TMPVAL = SLIPRING(I)%FAC_S(3)
96 CALL QAPRINT('slipring facs3 ',0,TMPVAL)
97C
98 DO J=1,SLIPRING(I)%NFRAM
99C
100 CALL QAPRINT('slipring n1 ',ITAB(SLIPRING(I)%FRAM(J)%NODE(1)),0.0_8)
101 CALL QAPRINT('slipring n2 ',ITAB(SLIPRING(I)%FRAM(J)%NODE(2)),0.0_8)
102 CALL QAPRINT('slipring n3 ',ITAB(SLIPRING(I)%FRAM(J)%NODE(3)),0.0_8)
103 CALL QAPRINT('slipring anchor ',itab(slipring(i)%FRAM(j)%ANCHOR_NODE),0.0_8)
104 IF (slipring(i)%FRAM(j)%ORIENTATION_NODE > 0) THEN
105 CALL qaprint('SLIPRING ORIENTATION NODE ',itab(slipring(i)%FRAM(j)%ORIENTATION_NODE),0.0_8)
106 ENDIF
107 CALL qaprint('SLIPRING DIRECTION1 ',slipring(i)%FRAM(j)%STRAND_DIRECTION(1),0.0_8)
108 CALL qaprint('SLIPRING DIRECTION2 ',slipring(i)%FRAM(j)%STRAND_DIRECTION(2),0.0_8)
109C
110 tmpval = slipring(i)%FRAM(j)%ORIENTATION_ANGLE
111 CALL qaprint('SLIPRING ANGLE ',0,tmpval)
112C
113 tmpval = slipring(i)%FRAM(j)%VECTOR(1)
114 CALL qaprint('SLIPRING VECTOR1 ',0,tmpval)
115 tmpval = slipring(i)%FRAM(j)%VECTOR(2)
116 CALL qaprint('SLIPRING VECTOR2 ',0,tmpval)
117 tmpval = slipring(i)%FRAM(j)%VECTOR(3)
118 CALL qaprint('SLIPRING VECTOR3 ',0,tmpval)
119 tmpval = slipring(i)%FRAM(j)%VECTOR(4)
120 CALL qaprint('SLIPRING VECTOR4 ',0,tmpval)
121 tmpval = slipring(i)%FRAM(j)%VECTOR(5)
122 CALL qaprint('SLIPRING VECTOR5 ',0,tmpval)
123 tmpval = slipring(i)%FRAM(j)%VECTOR(6)
124 CALL qaprint('SLIPRING VECTOR6 ',0,tmpval)
125C
126 ENDDO
127C
128 ENDDO
129 ENDIF
130C
131 ok_qa = myqakey('/RETRACTOR')
132C
133 IF (ok_qa) THEN
134 DO i = 1, nretractor
135C
136 CALL qaprint('RETRACTOR ID ',retractor(i)%ID,0.0_8)
137 CALL qaprint('RETRACTOR N1 ',itab(retractor(i)%NODE(1)),0.0_8)
138 CALL qaprint('RETRACTOR N2 ',itab(retractor(i)%NODE(2)),0.0_8)
139 CALL qaprint('RETRACTOR ANCHOR ',itab(retractor(i)%ANCHOR_NODE),0.0_8)
140 CALL qaprint('RETRACTOR DIRECTION ',retractor(i)%STRAND_DIRECTION,0.0_8)
141 CALL qaprint('RETRACTOR FUNC1 ',retractor(i)%IFUNC(1),0.0_8)
142 CALL qaprint('RETRACTOR FUNC2 ',retractor(i)%IFUNC(2),0.0_8)
143 CALL qaprint('RETRACTOR FUNC3 ',retractor(i)%IFUNC(3),0.0_8)
144 CALL qaprint('RETRACTOR SENSID1 ',retractor(i)%ISENS(1),0.0_8)
145 CALL qaprint('RETRACTOR SENSID2 ',retractor(i)%ISENS(2),0.0_8)
146 CALL qaprint('RETRACTOR TENSTYP ',retractor(i)%TENS_TYP,0.0_8)
147 CALL qaprint('RETRACTOR INACTIVE NODES ',retractor(i)%INACTI_NNOD,0.0_8)
148C
149 DO j=1,retractor(i)%INACTI_NNOD
150 CALL qaprint('RETRACTOR INACTI NODE ',itab(retractor(i)%INACTI_NODE(j)),0.0_8)
151 ENDDO
152C
153 tmpval = retractor(i)%VECTOR(1)
154 CALL qaprint('RETRACTOR VECTOR1 ',0,tmpval)
155 tmpval = retractor(i)%VECTOR(2)
156 CALL qaprint('RETRACTOR VECTOR2 ',0,tmpval)
157 tmpval = retractor(i)%VECTOR(3)
158 CALL qaprint('RETRACTOR VECTOR3 ',0,tmpval)
159C
160 tmpval = retractor(i)%ELEMENT_SIZE
161 CALL qaprint('RETRACTOR ELEM SIZE ',0,tmpval)
162 tmpval = retractor(i)%FORCE
163 CALL qaprint('RETRACTOR FORCE ',0,tmpval)
164C
165 tmpval = retractor(i)%FAC(1)
166 CALL qaprint('RETRACTOR FAC1 ',0,tmpval)
167 tmpval = retractor(i)%FAC(2)
168 CALL qaprint('RETRACTOR FAC2 ',0,tmpval)
169 tmpval = retractor(i)%FAC(3)
170 CALL qaprint('RETRACTOR FAC3 ',0,tmpval)
171 tmpval = retractor(i)%FAC(4)
172 CALL qaprint('RETRACTOR FAC4 ',0,tmpval)
173C
174 tmpval = retractor(i)%PULLOUT
175 CALL qaprint('RETRACTOR PULLOUT ',0,tmpval)
176C
177 ENDDO
178 ENDIF
179C-----------------------------------------------
180 RETURN
181 END
182
id
initmumps id
Definition multiplerhs_example.m:4
qa_out_mod
Definition qa_out_mod.F:78
qa_out_mod::myqakey
logical function myqakey(value)
@purpose Check if a given value is part of the values set by env variable Useful to make a condition ...
Definition qa_out_mod.F:694
qa_out_mod::qaprint
subroutine qaprint(name, idin, value)
@purpose print one entry to QA extract file example of call for real print CALL QAPRINT('MY_LABEL',...
Definition qa_out_mod.F:390
seatbelt_mod
Definition seatbelt_mod.F:55
seatbelt_mod::retractor
type(retractor_struct), dimension(:), allocatable retractor
Definition seatbelt_mod.F:155
seatbelt_mod::slipring
type(slipring_struct), dimension(:), allocatable slipring
Definition seatbelt_mod.F:110
st_qaprint_seatbelts
subroutine st_qaprint_seatbelts(itab)
Definition st_qaprint_seatbelts.F:31