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