OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_element.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr17_c.inc"
#include "scr23_c.inc"
#include "sphcom.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ st_qaprint_element()

subroutine st_qaprint_element ( integer, dimension(nixs,*), intent(in) ixs,
integer, dimension(6,*), intent(in) ixs10,
integer, dimension(npropmi,*), intent(in) ipm,
integer, dimension(npropgi,*), intent(in) igeo,
integer, dimension(*), intent(in) itab,
integer, dimension(*), intent(in) isolnod,
integer, dimension(nixr,*), intent(in) ixr,
integer, dimension(*), intent(in) r_skew,
integer, dimension(liskn,*), intent(in) iskwn,
integer, dimension(nixp,*), intent(in) ixp,
integer, dimension(nixt,*), intent(in) ixt,
dimension(3,numnod), intent(in) x,
integer, dimension(nixc,*), intent(in) ixc,
integer, dimension(nixtg,*), intent(in) ixtg,
dimension(*), intent(in) thke,
dimension(*), intent(in) sh4ang,
dimension(*), intent(in) thkec,
dimension(*), intent(in) sh3ang,
integer, dimension(nisp,*), intent(in) kxsp,
integer, dimension(*), intent(in) ipartsp,
integer, dimension(lipart1,*), intent(in) ipart,
integer, dimension(5,*), intent(in) ixr_kj,
integer, dimension(nixx,*), intent(in) kxx,
integer, dimension(*), intent(in) ixx,
integer, dimension(*), intent(in) ipartx,
integer, dimension(4,*), intent(in) ixri,
integer, dimension(8,*), intent(in) ixs16,
integer, dimension(nixq,*), intent(in) ixq,
integer, dimension(numelp), intent(in) ibeam_vector,
dimension(3,numelp), intent(in) rbeam_vector )

Definition at line 31 of file st_qaprint_element.F.

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
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