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

Go to the source code of this file.

Functions/Subroutines

subroutine st_qaprint_reference_state (xrefc, xreftg, xrefs, tagxref, ixs, ixc, ixtg)

Function/Subroutine Documentation

◆ st_qaprint_reference_state()

subroutine st_qaprint_reference_state ( dimension(4,3,numelc), intent(in) xrefc,
dimension(3,3,numeltg), intent(in) xreftg,
dimension(8,3,numels8), intent(in) xrefs,
integer, dimension(numnod), intent(in) tagxref,
integer, dimension(nixs,*), intent(in) ixs,
integer, dimension(nixc,*), intent(in) ixc,
integer, dimension(nixtg,*), intent(in) ixtg )

Definition at line 31 of file st_qaprint_reference_state.F.

33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE my_alloc_mod
37 USE qa_out_mod
38 USE message_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "com04_c.inc"
47#include "scr03_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER, INTENT(IN) :: TAGXREF(NUMNOD),IXC(NIXC,*),IXTG(NIXTG,*),IXS(NIXS,*)
52 my_real, INTENT(IN) ::
53 . xrefc(4,3,numelc),xreftg(3,3,numeltg),xrefs(8,3,numels8)
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER IE,IN,NN,TEMP_INT,NC,ELEM_ID,WORK(70000)
58 CHARACTER (LEN=255) :: VARNAME
59 DOUBLE PRECISION TEMP_DOUBLE
60 INTEGER, ALLOCATABLE, DIMENSION(:) :: INDEX,ITR1
61C-----------------------------------------------
62C S o u r c e L i n e s
63C-----------------------------------------------
64C
65C-----------------------------------------------
66C XREF
67C-----------------------------------------------
68
69 IF (myqakey('/XREF')) THEN
70C
71 WRITE(varname,'(A)') 'NXREF'
72 temp_int = nxref
73 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
74C
75 IF (nxref > 0) THEN
76C
77 DO ie = 1,numelc
78 DO in = 1,4
79 nn = ixc(in+1,ie)
80 IF (tagxref(nn) == 1) THEN
81 ! Number of the node
82 WRITE(varname,'(A)') 'XREFC_NODE'
83 temp_int = nn
84 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
85 ! Coordinate X of the node
86 WRITE(varname,'(A)') 'XREFC_X'
87 temp_double = xrefc(in,1,ie)
88 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
89 ! coordinate y of the node
90 WRITE(varname,'(A)') 'XREFC_Y'
91 temp_double = xrefc(in,2,ie)
92 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
93 ! Coordinate Z of the node
94 WRITE(varname,'(A)') 'XREFC_Z'
95 temp_double = xrefc(in,3,ie)
96 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
97 ENDIF
98 ENDDO
99 ENDDO
100C
101 DO ie = 1,numeltg
102 DO in = 1,3
103 nn = ixtg(in+1,ie)
104 IF (tagxref(nn) == 1) THEN
105 ! Number of the node
106 WRITE(varname,'(A)') 'XREFTG_NODE'
107 temp_int = nn
108 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
109 ! Coordinate X of the node
110 WRITE(varname,'(A)') 'XREFTG_X'
111 temp_double = xreftg(in,1,ie)
112 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
113 ! Coordinate Y of the node
114 WRITE(varname,'(A)') 'XREFTG_Y'
115 temp_double = xreftg(in,2,ie)
116 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
117 ! Coordinate Z of the node
118 WRITE(varname,'(A)') 'XREFTG_Z'
119 temp_double = xreftg(in,3,ie)
120 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
121 ENDIF
122 ENDDO
123 ENDDO
124C
125 DO ie = 1,numels8
126 DO in = 1,8
127 nn = ixs(in+1,ie)
128 IF (tagxref(nn) == 1) THEN
129 ! Number of the node
130 WRITE(varname,'(A)') 'XREFS_NODE'
131 temp_int = nn
132 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
133 ! Coordinate X of the node
134 WRITE(varname,'(A)') 'XREFS_X'
135 temp_double = xrefs(in,1,ie)
136 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
137 ! Coordinate Y of the node
138 WRITE(varname,'(A)') 'XREFS_Y'
139 temp_double = xrefs(in,2,ie)
140 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
141 ! Coordinate Z of the node
142 WRITE(varname,'(A)') 'XREFS_Z'
143 temp_double = xrefs(in,3,ie)
144 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
145 ENDIF
146 ENDDO
147 ENDDO
148C
149 ENDIF
150C
151 ENDIF
152
153C-----------------------------------------------
154C EREF
155C-----------------------------------------------
156 IF (myqakey('/EREF')) THEN
157C
158 WRITE(varname,'(A)') 'NEREF'
159 temp_int = neref
160 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
161C
162 IF (neref > 0) THEN
163C
164 CALL my_alloc(index,2*numelc)
165 CALL my_alloc(itr1,numelc)
166C
167 DO ie=1,numelc
168 itr1(ie)=ixc(nixc,ie)
169 ENDDO
170 CALL my_orders(0,work,itr1,index,numelc,1)
171C
172 DO ie = 1,numelc
173 nc=index(ie)
174 elem_id = ixc(nixc,nc)
175C
176 DO in = 1,4
177 nn = ixc(in+1,nc)
178 IF (tagxref(nn) /= 1) THEN
179 ! Id of the element
180 WRITE(varname,'(A,I0)') 'eref_shell_element_node ',IN
181 TEMP_INT = ELEM_ID
182 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
183 IF (XREFC(IN,1,NC) > 0) THEN
184 ! Coordinate X of the node
185 WRITE(VARNAME,'(a)') 'erefc_x'
186 TEMP_DOUBLE = XREFC(IN,1,NC)
187 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
188 ENDIF
189 IF (XREFC(IN,2,NC) > 0) THEN
190 ! Coordinate Y of the node
191 WRITE(VARNAME,'(a)') 'erefc_y'
192 TEMP_DOUBLE = XREFC(IN,2,NC)
193 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
194 ENDIF
195 IF (XREFC(IN,3,NC) > 0) THEN
196 ! Coordinate Z of the node
197 WRITE(VARNAME,'(a)') 'erefc_z'
198 TEMP_DOUBLE = XREFC(IN,3,NC)
199 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
200 ENDIF
201 ENDIF
202 ENDDO
203C
204 ENDDO
205 DEALLOCATE(INDEX,ITR1)
206C
207 CALL MY_ALLOC(INDEX,2*NUMELTG)
208 CALL MY_ALLOC(ITR1,NUMELTG)
209C
210 DO IE=1,NUMELTG
211 ITR1(IE)=IXTG(NIXTG,IE)
212 ENDDO
213 CALL MY_ORDERS(0,WORK,ITR1,INDEX,NUMELTG,1)
214C
215 DO IE = 1,NUMELTG
216 NC=INDEX(IE)
217 ELEM_ID = IXTG(NIXTG,NC)
218C
219 DO IN = 1,3
220 NN = IXTG(IN+1,NC)
221 IF (TAGXREF(NN) /= 1) THEN
222 ! Id of the element
223 WRITE(VARNAME,'(a,i0)') 'eref_sh3n_element_node ',IN
224 TEMP_INT = ELEM_ID
225 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
226 IF (XREFTG(IN,1,NC) > 0) THEN
227 ! Coordinate X of the node
228 WRITE(VARNAME,'(a)') 'ereftg_x'
229 TEMP_DOUBLE = XREFTG(IN,1,NC)
230 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
231 ENDIF
232 IF (XREFTG(IN,2,NC) > 0) THEN
233 ! Coordinate Y of the node
234 WRITE(VARNAME,'(a)') 'ereftg_y'
235 TEMP_DOUBLE = XREFTG(IN,2,NC)
236 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
237 ENDIF
238 IF (XREFTG(IN,3,NC) > 0) THEN
239 ! Coordinate Z of the node
240 WRITE(VARNAME,'(a)') 'ereftg_z'
241 TEMP_DOUBLE = XREFTG(IN,3,NC)
242 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
243 ENDIF
244 ENDIF
245 ENDDO
246C
247 ENDDO
248 DEALLOCATE(INDEX,ITR1)
249C
250 CALL MY_ALLOC(INDEX,2*NUMELS8)
251 CALL MY_ALLOC(ITR1,NUMELS8)
252C
253 DO IE=1,NUMELS8
254 ITR1(IE)=IXS(NIXS,IE)
255 ENDDO
256 CALL MY_ORDERS(0,WORK,ITR1,INDEX,NUMELS8,1)
257C
258 DO IE = 1,NUMELS8
259 NC=INDEX(IE)
260 ELEM_ID = IXS(NIXS,NC)
261C
262 DO IN = 1,8
263 NN = IXS(IN+1,NC)
264 IF (TAGXREF(NN) /= 1) THEN
265 ! Id of the element
266 WRITE(VARNAME,'(a,i0)') 'eref_solid_element_node ',IN
267 TEMP_INT = ELEM_ID
268 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
269 IF (XREFS(IN,1,NC) > 0) THEN
270 ! Coordinate X of the node
271 WRITE(VARNAME,'(a)') 'erefs_x'
272 TEMP_DOUBLE = XREFS(IN,1,NC)
273 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
274 ENDIF
275 IF (XREFS(IN,2,NC) > 0) THEN
276 ! Coordinate Y of the node
277 WRITE(VARNAME,'(a)') 'erefs_y'
278 TEMP_DOUBLE = XREFS(IN,2,NC)
279 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
280 ENDIF
281 IF (XREFS(IN,3,NC) > 0) THEN
282 ! Coordinate Z of the node
283 WRITE(VARNAME,'(a)') 'erefs_z'
284 TEMP_DOUBLE = XREFS(IN,3,NC)
285 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
286 ENDIF
287 ENDIF
288 ENDDO
289C
290 ENDDO
291 DEALLOCATE(INDEX,ITR1)
292C
293 ENDIF
294
295 ENDIF
296
297
my_real
#define my_real
Definition cppsort.cpp:32
the
end diagonal values have been computed in the(sparse) matrix id.SOL
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
message_mod
Definition message_mod.F:1249
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