OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_element.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_element ../starter/source/output/qaprint/st_qaprint_element.F
25!||--- called by ------------------------------------------------------
26!|| st_qaprint_driver ../starter/source/output/qaprint/st_qaprint_driver.f
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| message_mod ../starter/share/message_module/message_mod.F
30!||====================================================================
31 SUBROUTINE st_qaprint_element(IXS , IXS10, IPM , IGEO, ITAB,
32 1 ISOLNOD,IXR, R_SKEW,ISKWN, IXP ,
33 2 IXT ,X , IXC ,IXTG ,THKE ,
34 3 SH4ANG ,THKEC,SH3ANG,KXSP ,IPARTSP,
35 4 IPART ,IXR_KJ,KXX ,IXX , IPARTX ,
36 5 IXRI ,IXS16 ,IXQ ,IBEAM_VECTOR,RBEAM_VECTOR)
37C============================================================================
38C M o d u l e s
39C-----------------------------------------------
40 USE qa_out_mod
41 USE message_mod
42 USE my_alloc_mod
43 USE names_and_titles_mod , ONLY : nchartitle
44 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com04_c.inc"
53#include "param_c.inc"
54#include "scr17_c.inc"
55#include "scr23_c.inc"
56#include "sphcom.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER, INTENT(IN) :: IXS(NIXS,*), IXS10(6,*), IPM(NPROPMI,*), IGEO(NPROPGI,*)
61 INTEGER, INTENT(IN) :: ITAB(*), ISOLNOD(*),IXR_KJ(5,*)
62 INTEGER, INTENT(IN) :: IXR(NIXR,*), R_SKEW(*), ISKWN(LISKN,*), IXP(NIXP,*), IXT(NIXT,*),
63 . IXC(NIXC,*),IXTG(NIXTG,*),KXSP(NISP,*),IPARTSP(*),IPART(LIPART1,*),
64 . KXX(NIXX,*),IXX(*),IPARTX(*),IXRI(4,*),IXS16(8,*),IXQ(NIXQ,*)
65 INTEGER, INTENT(IN) :: IBEAM_VECTOR(NUMELP)
66 my_real, INTENT(IN) ::
67 . x(3,numnod),
68 . thke(*),thkec(*),sh4ang(*),sh3ang(*)
69 my_real, INTENT(IN) :: rbeam_vector(3,numelp)
70C--------------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER I, J, MY_ID, TEMP_INT, NS, MY_MID, MY_PID, MY_NOD, MY_SKEW,NC
74 INTEGER :: WORK(70000),NUMEL_KJ
75 INTEGER, ALLOCATABLE, DIMENSION(:) :: INDEX,ITR1
76 CHARACTER(LEN=NCHARTITLE)::TITR
77 CHARACTER (LEN=255) :: VARNAME
78 DOUBLE PRECISION TEMP_DOUBLE
79 INTEGER ITETRA4(4),IPENTA6(6)
80 DATA itetra4/2,4,7,6/,ipenta6/2,3,4,6,7,8/
81C-----------------------------------------------
82C Elements
83C-----------------------------------------------
84
85 IF (myqakey('ELEMENTS')) THEN
86C
87C-----------------------------------------------
88C Solid elements
89C-----------------------------------------------
90C
91 CALL my_alloc(index,2*numels)
92 CALL my_alloc(itr1,numels)
93C
94 DO i=1,numels8
95 itr1(i)=ixs(nixs,i)
96 ENDDO
97 CALL my_orders(0,work,itr1,index,numels8,1)
98 DO i=1,numels8
99 ns=index(i)
100C
101 my_id = ixs(nixs,ns)
102 CALL qaprint('A_SOLID_ELEMENT_ID', my_id,0.0_8)
103C
104 my_mid = ipm(1,ixs(1,ns))
105 CALL qaprint('A_SOLID_ELEMENT_MID', my_mid,0.0_8)
106C
107 my_pid = igeo(1,ixs(10,ns))
108 CALL qaprint('A_SOLID_ELEMENT_PID', my_pid,0.0_8)
109C
110 IF(isolnod(ns)==4)THEN
111 DO j=1,4
112 IF(ixs(itetra4(j),ns)/=0)THEN
113C
114C VARNAME: variable name in ref.extract (without blanks)
115C
116 my_nod = itab(ixs(itetra4(j),ns))
117 WRITE(varname,'(A,I0)') 'NODE_',j
118 CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
119 END IF
120 END DO
121 ELSEIF(isolnod(ns)==6)THEN
122 DO j=1,6
123 IF(ixs(ipenta6(j),ns)/=0)THEN
124C
125C VARNAME: variable name in ref.extract (without blanks)
126C
127 my_nod = itab(ixs(ipenta6(j),ns))
128 WRITE(varname,'(A,I0)') 'NODE_',j
129 CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
130 END IF
131 END DO
132 ELSEIF(isolnod(ns)==8)THEN
133 DO j=2,9
134 IF(ixs(j,ns)/=0)THEN
135C
136C VARNAME: variable name in ref.extract (without blanks)
137C
138 my_nod = itab(ixs(j,ns))
139 WRITE(varname,'(A,I0)') 'NODE_',j-1
140 CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
141 END IF
142 END DO
143 END IF
144C
145 END DO ! DO I=1,NUMELS8
146C
147C-----------------------------------------------
148C Tetra10 Elements
149C-----------------------------------------------
150 DO i=1,numels10
151 itr1(i)=ixs(nixs,numels8+i)
152 ENDDO
153 CALL my_orders(0,work,itr1,index,numels10,1)
154C
155 DO i=1,numels10
156 ns=index(i)
157C
158 my_id = ixs(nixs,numels8+ns)
159 CALL qaprint('A_TETRA10_ELEMENT_ID', my_id,0.0_8)
160C
161 my_mid = ipm(1,ixs(1,numels8+ns))
162 CALL qaprint('A_TETRA10_ELEMENT_MID', my_mid,0.0_8)
163C
164 my_pid = igeo(1,ixs(10,numels8+ns))
165 CALL qaprint('A_TETRA10_ELEMENT_PID', my_pid,0.0_8)
166C
167 DO j=1,4
168 IF(ixs(itetra4(j),numels8+ns)/=0)THEN
169C
170C VARNAME: variable name in ref.extract (without blanks)
171C
172 my_nod = itab(ixs(itetra4(j),numels8+ns))
173 WRITE(varname,'(A,I0)') 'NODE_',j
174 CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
175 END IF
176 END DO
177C
178 DO j=1,6
179 IF(ixs10(j,ns)/=0)THEN
180C
181C VARNAME: variable name in ref.extract (without blanks)
182C
183 my_nod = itab(ixs10(j,ns))
184 WRITE(varname,'(A,I0)') 'NODE_',j+4
185 CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
186 END IF
187 END DO
188C
189 END DO ! DO I=1,NUMELS10
190C-----------------------------------------------
191C Shell16 elements
192C-----------------------------------------------
193 DO i=1,numels16
194 itr1(i)=ixs(nixs,numels8+numels10+numels20+i)
195 ENDDO
196 CALL my_orders(0,work,itr1,index,numels16,1)
197C
198 DO i=1,numels16
199 ns=index(i)
200C
201 my_id = ixs(nixs,numels8+numels10+numels20+ns)
202 CALL qaprint('A_SHEL16_ELEMENT_ID', my_id,0.0_8)
203C
204 my_mid = ipm(1,ixs(1,numels8+numels10+numels20+ns))
205 CALL qaprint('A_SHEL16_ELEMENT_MID', my_mid,0.0_8)
206C
207 my_pid = igeo(1,ixs(10,numels8+numels10+numels20+ns))
208 CALL qaprint('A_SHEL16_ELEMENT_PID', my_pid,0.0_8)
209C
210 DO j=2,9
211 IF(ixs(j,numels8+numels10+numels20+ns)/=0)THEN
212C
213C VARNAME: variable name in ref.extract (without blanks)
214C
215 my_nod = itab(ixs(j,numels8+numels10+numels20+ns))
216 WRITE(varname,'(A,I0)') 'NODE_',j
217 CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
218 END IF
219 END DO
220C
221 DO j=1,8
222 IF(ixs16(j,ns)/=0)THEN
223C
224C VARNAME: variable name in ref.extract (without blanks)
225C
226 my_nod = itab(ixs16(j,ns))
227 WRITE(varname,'(A,I0)') 'NODE_',j+8
228 CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
229 END IF
230 END DO
231C
232 END DO ! DO I=1,NUMELS16
233
234 DEALLOCATE(index,itr1)
235C
236C-----------------------------------------------
237C Spring elements
238C-----------------------------------------------
239C
240 CALL my_alloc(index,2*numelr)
241 CALL my_alloc(itr1,numelr)
242C
243 DO i=1,numelr
244 itr1(i)=ixr(nixr,i)
245 ENDDO
246 CALL my_orders(0,work,itr1,index,numelr,1)
247C
248 DO i=1,numelr
249 ns=index(i)
250C
251 my_id = ixr(nixr,ns)
252 CALL qaprint('A_SPRING_ELEMENT_ID', my_id,0.0_8)
253C
254 my_mid = 0
255 IF (ixr(5,ns) > 0) my_mid = ipm(1,ixr(5,ns))
256 CALL qaprint('A_SPRING_ELEMENT_MID', my_mid,0.0_8)
257C
258 my_pid = igeo(1,ixr(1,ns))
259 CALL qaprint('A_SPRING_ELEMENT_PID', my_pid,0.0_8)
260C
261 DO j=2,3
262 IF(ixr(j,ns)/=0)THEN
263 my_nod = itab(ixr(j,ns))
264 WRITE(varname,'(A,I0)') 'NODE_',j-1
265 CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
266 END IF
267 END DO
268C
269 IF(ixr(4,ns)/=0)THEN
270 my_nod = itab(ixr(4,ns))
271 WRITE(varname,'(A,I0)') 'NODE_',3
272 CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
273C
274 temp_double = x(1,ixr(4,ns))-x(1,ixr(2,ns))
275 CALL qaprint('--> VEC_N1N3_X', 0,temp_double)
276 temp_double = x(2,ixr(4,ns))-x(2,ixr(2,ns))
277 CALL qaprint('--> VEC_N1N3_Y', 0,temp_double)
278 temp_double = x(3,ixr(4,ns))-x(3,ixr(2,ns))
279 CALL qaprint('--> VEC_N1N3_Z', 0,temp_double)
280 END IF
281C
282 IF(r_skew(ns)/=0)THEN
283 my_skew = iskwn(4,r_skew(ns))
284 WRITE(varname,'(A,I0)') 'SKEW_',j-1
285 CALL qaprint(varname(1:len_trim(varname)), my_skew,0.0_8)
286 END IF
287C
288 END DO ! DO I=1,NUMELR
289C
290 DEALLOCATE(index,itr1)
291C
292C----- Additional output of IXR_KJ for kjoints
293C
294 IF (numelr > 0) THEN
295C
296 numel_kj = ixr_kj(1,numelr+1)
297 CALL my_alloc(index,2*numel_kj)
298 CALL my_alloc(itr1,numel_kj)
299C
300 DO i=1,numel_kj
301 itr1(i)=ixr_kj(4,i)
302 ENDDO
303 CALL my_orders(0,work,itr1,index,numel_kj,1)
304C
305 DO i=1,numel_kj
306 ns=index(i)
307C
308 DO j=1,3
309 IF(ixr_kj(j,ns)/=0)THEN
310 my_nod = itab(ixr_kj(j,ns))
311 WRITE(varname,'(A,X,I0,X,A,I0)') 'KJOINT_ID',ixr_kj(4,ns),'ADDITIONAL_NODE_',3+j
312 CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
313 END IF
314 END DO
315C
316 ENDDO
317C
318 DEALLOCATE(index,itr1)
319C
320 ENDIF
321C
322C-----------------------------------------------
323C Beam elements
324C-----------------------------------------------
325C
326 CALL my_alloc(index,2*numelp)
327 CALL my_alloc(itr1,numelp)
328C
329 DO i=1,numelp
330 itr1(i)=ixp(nixp,i)
331 ENDDO
332 CALL my_orders(0,work,itr1,index,numelp,1)
333C
334 DO i=1,numelp
335 ns=index(i)
336C
337 my_id = ixp(nixp,ns)
338 CALL qaprint('A_BEAM_ELEMENT_ID', my_id,0.0_8)
339C
340 my_mid = ipm(1,ixp(1,ns))
341 CALL qaprint('A_BEAM_ELEMENT_MID', my_mid,0.0_8)
342C
343 my_pid = igeo(1,ixp(5,ns))
344 CALL qaprint('A_BEAM_ELEMENT_PID', my_pid,0.0_8)
345C
346 DO j=2,3
347 IF(ixp(j,ns)/=0)THEN
348 my_nod = itab(ixp(j,ns))
349 WRITE(varname,'(A,I0)') 'NODE_',j-1
350 CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
351 END IF
352 END DO
353C
354 IF (ibeam_vector(ns) == 1) THEN
355 temp_double = rbeam_vector(1,ns)
356 CALL qaprint('--> INPUT_VEC_X', 0,temp_double)
357 temp_double = rbeam_vector(2,ns)
358 CALL qaprint('--> INPUT_VEC_Y', 0,temp_double)
359 temp_double = rbeam_vector(3,ns)
360 CALL qaprint('--> INPUT_VEC_Z', 0,temp_double)
361 ELSEIF(ixp(4,ns)/=0)THEN
362 my_nod = itab(ixp(4,ns))
363 WRITE(varname,'(A,I0)') 'NODE_',j-1
364 CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
365C
366 temp_double = x(1,ixp(4,ns))-x(1,ixp(2,ns))
367 CALL qaprint('--> VEC_N1N3_X', 0,temp_double)
368 temp_double = x(2,ixp(4,ns))-x(2,ixp(2,ns))
369 CALL qaprint('--> VEC_N1N3_Y', 0,temp_double)
370 temp_double = x(3,ixp(4,ns))-x(3,ixp(2,ns))
371 CALL qaprint('--> VEC_N1N3_Z', 0,temp_double)
372 END IF
373C
374 END DO ! DO I=1,NUMELP
375C
376 DEALLOCATE(index,itr1)
377C
378C-----------------------------------------------
379C Truss elements
380C-----------------------------------------------
381C
382 CALL my_alloc(index,2*numelt)
383 CALL my_alloc(itr1,numelt)
384C
385 DO i=1,numelt
386 itr1(i)=ixt(nixt,i)
387 ENDDO
388 CALL my_orders(0,work,itr1,index,numelt,1)
389C
390 DO i=1,numelt
391 ns=index(i)
392C
393 my_id = ixt(nixt,ns)
394 CALL qaprint('A_TRUSS_ELEMENT_ID', my_id,0.0_8)
395C
396 my_mid = ipm(1,ixt(1,ns))
397 CALL qaprint('A_TRUSS_ELEMENT_MID', my_mid,0.0_8)
398C
399 my_pid = igeo(1,ixt(4,ns))
400 CALL qaprint('A_TRUSS_ELEMENT_PID', my_pid,0.0_8)
401C
402 DO j=2,3
403 IF(ixt(j,ns)/=0)THEN
404 my_nod = itab(ixt(j,ns))
405 WRITE(varname,'(A,I0)') 'NODE_',j-1
406 CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
407 END IF
408 END DO
409C
410 END DO ! DO I=1,NUMELT
411C
412 DEALLOCATE(index,itr1)
413C
414C-----------------------------------------------
415C SHELL elements
416C-----------------------------------------------
417 CALL my_alloc(index,2*numelc)
418 CALL my_alloc(itr1,numelc)
419C
420 DO i=1,numelc
421 itr1(i)=ixc(nixc,i)
422 ENDDO
423
424 CALL my_orders(0,work,itr1,index,numelc,1)
425 DO i=1,numelc
426 nc=index(i)
427C
428 my_id = ixc(nixc,nc)
429 CALL qaprint('A_SHELL_ELEMENT_ID', my_id,0.0_8)
430C
431 my_mid = ipm(1,ixc(1,nc))
432 CALL qaprint('A_SHELL_ELEMENT_MID', my_mid,0.0_8)
433C
434 my_pid = igeo(1,ixc(6,nc))
435 CALL qaprint('A_SHELL_ELEMENT_PID', my_pid,0.0_8)
436C
437 DO j=1,4
438 my_nod = itab(ixc(j+1,nc))
439 WRITE(varname,'(A,I0)') 'NODE_',j
440 CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
441 END DO
442C
443 WRITE(varname,'(A,I0)') 'THK_'
444 temp_double = thke(nc)
445 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
446C
447 WRITE(varname,'(A,I0)') 'ANGLE_'
448 temp_double = sh4ang(nc)
449 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
450
451 ENDDO
452 DEALLOCATE(index,itr1)
453C-----------------------------------------------
454C QUAD elements
455C-----------------------------------------------
456 CALL my_alloc(index,2*numelq)
457 CALL my_alloc(itr1,numelq)
458C
459 DO i=1,numelq
460 itr1(i)=ixq(nixq,i)
461 ENDDO
462
463 CALL my_orders(0,work,itr1,index,numelq,1)
464 DO i=1,numelq
465 nc=index(i)
466C
467 my_id = ixq(nixq,nc)
468 CALL qaprint('A_QUAD_ELEMENT_ID', my_id,0.0_8)
469C
470 my_mid = ipm(1,ixq(1,nc))
471 CALL qaprint('A_QUAD_ELEMENT_MID', my_mid,0.0_8)
472C
473 my_pid = igeo(1,ixq(6,nc))
474 CALL qaprint('A_QUAD_ELEMENT_PID', my_pid,0.0_8)
475C
476 DO j=1,4
477 my_nod = itab(ixq(j+1,nc))
478 WRITE(varname,'(A,I0)') 'NODE_',j
479 CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
480 END DO
481C
482 ENDDO
483 DEALLOCATE(index,itr1)
484C-----------------------------------------------
485C SH3N elements
486C-----------------------------------------------
487 CALL my_alloc(index,2*numeltg)
488 CALL my_alloc(itr1,numeltg)
489C
490 DO i=1,numeltg
491 itr1(i)=ixtg(nixtg,i)
492 ENDDO
493
494 CALL my_orders(0,work,itr1,index,numeltg,1)
495 DO i=1,numeltg
496 nc=index(i)
497C
498 my_id = ixtg(nixtg,nc)
499 CALL qaprint('A_SH3N_ELEMENT_ID', my_id,0.0_8)
500C
501 my_mid = ipm(1,ixtg(1,nc))
502 CALL qaprint('A_SH3N_ELEMENT_MID', my_mid,0.0_8)
503C
504 my_pid = igeo(1,ixtg(5,nc))
505 CALL qaprint('A_SH3N_ELEMENT_PID', my_pid,0.0_8)
506C
507 DO j=1,3
508 my_nod = itab(ixtg(j+1,nc))
509 WRITE(varname,'(A,I0)') 'NODE_',j
510 CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
511 END DO
512C
513 WRITE(varname,'(A,I0)') 'THK_'
514 temp_double = thkec(nc)
515 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
516C
517 WRITE(varname,'(A,I0)') 'ANGLE_'
518 temp_double = sh3ang(nc)
519 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
520
521 ENDDO
522 DEALLOCATE(index,itr1)
523C
524C-----------------------------------------------
525C Sph elements
526C-----------------------------------------------
527 CALL my_alloc(index,2*numsph)
528 CALL my_alloc(itr1,numsph)
529C
530 DO i=1,numsph
531 itr1(i)=kxsp(nisp,i)
532 ENDDO
533 CALL my_orders(0,work,itr1,index,numsph,1)
534C
535 DO i=1,numsph
536C
537 ns=index(i)
538C
539 my_id = kxsp(nisp,ns)
540 CALL qaprint('A_SPH_CELL_ELEMENT_ID', my_id,0.0_8)
541C
542 my_id = ipartsp(ns)
543 CALL qaprint('A_SPH_CELL_PART_ID', my_id,0.0_8)
544
545 my_mid = ipart(1,ipartsp(ns))
546 CALL qaprint('A_SPH_CELL_MID', my_mid,0.0_8)
547C
548 my_pid = igeo(1,ipart(2,ipartsp(ns)))
549 CALL qaprint('A_SPH_CELL_PID', my_pid,0.0_8)
550C
551 DO j=2,7
552 my_id = kxsp(j,ns)
553 IF (my_id /= 0) THEN
554 WRITE(varname,'(A,I0)') 'KXSP_',j
555 CALL qaprint(varname(1:len_trim(varname)), my_id,0.0_8)
556 ENDIF
557 ENDDO
558C
559 ENDDO
560 DEALLOCATE(index,itr1)
561C-----------------------------------------------
562C Xelem elements
563C-----------------------------------------------
564 CALL my_alloc(index,2*numelx)
565 CALL my_alloc(itr1,numelx)
566C
567 DO i=1,numelx
568 itr1(i)=kxx(nixx,i)
569 ENDDO
570 CALL my_orders(0,work,itr1,index,numelx,1)
571C
572 DO i=1,numelx
573C
574 ns=index(i)
575C
576 my_id = kxx(nixx,ns)
577 CALL qaprint('A_XELEM_ELEMENT_ID', my_id,0.0_8)
578C
579 my_id = ipartx(ns)
580 CALL qaprint('A_XELEM_PART_ID', my_id,0.0_8)
581C
582 DO j=1,kxx(3,ns)
583 my_id = itab(ixx(kxx(4,ns)+j-1))
584 IF (my_id /= 0) THEN
585 WRITE(varname,'(A,I0)') 'IXX_',kxx(4,ns)+j
586 CALL qaprint(varname(1:len_trim(varname)), my_id,0.0_8)
587 ENDIF
588 ENDDO
589C
590 ENDDO
591 DEALLOCATE(index,itr1)
592C-----------------------------------------------
593C Rivet elements
594C-----------------------------------------------
595 CALL my_alloc(index,2*nrivet)
596 CALL my_alloc(itr1,nrivet)
597C
598 DO i=1,nrivet
599 itr1(i)=ixri(4,i)
600 ENDDO
601 CALL my_orders(0,work,itr1,index,nrivet,1)
602C
603 DO i=1,nrivet
604C
605 ns=index(i)
606C
607 my_id = ixri(4,ns)
608 CALL qaprint('A_RIVET_ELEMENT_ID', my_id,0.0_8)
609C
610 my_id = igeo(1,ixri(1,ns))
611 CALL qaprint('A_RIVET_PID', my_id,0.0_8)
612C
613 DO j=1,2
614 my_id = itab(ixri(j+1,ns))
615 IF (my_id /= 0) THEN
616 WRITE(varname,'(A,I0)') 'IXRI_',j
617 CALL qaprint(varname(1:len_trim(varname)), my_id,0.0_8)
618 ENDIF
619 ENDDO
620C
621 ENDDO
622 DEALLOCATE(index,itr1)
623C-----------------------------------------------
624 END IF
625C-----------------------------------------------
626 RETURN
627 END
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
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
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
st_qaprint_driver
subroutine st_qaprint_driver(igeo, geo, bufgeo, ipm, pm, bufmat, nom_opt, inom_opt, numloadp, iloadp, lloadp, loadp, ibcl, forc, ipres, pres, npby, lpby, rby, ibcr, fradia, ibcv, fconv, ibftemp, fbftemp, igrv, lgrv, agrv, ibfflux, fbfflux, itab, v, vr, w, icode, iskew, icfield, lcfield, cfield, dampr, temp, ibcslag, ipari, intbuf_tab, clusters, ibox, ipmas, ibfvel, fbfvel, nimpacc, laccelm, accelm, nom_sect, nstrf, secbuf, skew, iskwn, xframe, t_monvol, t_monvol_metadata, i2rupt, areasl, intbuf_fric_tab, npfricorth, mat_elem, pfricorth, irepforth, phiforth, vforth, xrefc, xreftg, xrefs, tagxref, ixs, ixc, ixtg, rwbuf, nprw, lprw, ithvar, ipart, subsets, ipartth, nthgrpmx, nimpdisp, nimpvel, detonators, ibcscyc, npc, pld, table, npts, irbe3, lrbe3, frbe3, mgrby, ixs10, isolnod, ixr, r_skew, ixp, ixt, x, thke, sh4ang, thkec, sh3ang, set, lsubmodel, igrnod, igrpart, igrbric, igrsh4n, igrsh3n, igrquad, igrbeam, igrtruss, igrspring, igrsurf, igrslin, ixq, ispcond, rtrans, irand, alea, xseed, xlas, las, irbe2, lrbe2, kxsp, ipartsp, drape, ixr_kj, iactiv, factiv, unitab, npbyl, lpbyl, rbyl, xyzref, sensors, func2d, inicrack, ipreload, preload, iflag_bpreload, ibmpc, ibmpc2, ibmpc3, ibmpc4, rbmpc, ljoint, nnlink, lnlink, bufsf, sbufsf_, pm_stack, geo_stack, igeo_stack, iparg, ipadmesh, padmesh, liflow, lrflow, iflow, rflow, sh4tree, sh3tree, sh4trim, sh3trim, qp_iperturb, qp_rperturb, llinal, linale, fvm_inivel, gjbufi, gjbufr, ms, in, lgauge, gauge, kxx, ixx, ipartx, ixri, ixs16, iexmad, fxbipm, fxbfile_tab, eigipm, eigrpm, isphio, vsphio, ebcs_tab, inimap1d, inimap2d, nsigsh, sigsh, nsigi, sigsp, nsigs, sigi, nsigbeam, sigbeam, nsigtruss, sigtruss, nsigrs, sigrs, merge_node_tab, merge_node_tol, imerge, nmerge_tot, iexlnk, drapeg, user_windows, output, defaults, glob_therm, pblast, ibeam_vector, rbeam_vector, damp_range_part)
Definition st_qaprint_driver.F:120
st_qaprint_element
subroutine st_qaprint_element(ixs, ixs10, ipm, igeo, itab, isolnod, ixr, r_skew, iskwn, ixp, ixt, x, ixc, ixtg, thke, sh4ang, thkec, sh3ang, kxsp, ipartsp, ipart, ixr_kj, kxx, ixx, ipartx, ixri, ixs16, ixq, ibeam_vector, rbeam_vector)
Definition st_qaprint_element.F:37
starter
program starter
Definition starter.F:39