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

Go to the source code of this file.

Functions/Subroutines

subroutine st_qaprint_nodes (itab, x, imerge, merge_node_tol, merge_node_tab, nmerge_tot, ms)

Function/Subroutine Documentation

◆ st_qaprint_nodes()

subroutine st_qaprint_nodes ( integer, dimension(*), intent(in) itab,
dimension(3,numnod), intent(in) x,
integer, dimension(*), intent(in) imerge,
dimension(*), intent(in) merge_node_tol,
integer, dimension(4,*), intent(in) merge_node_tab,
integer, intent(in) nmerge_tot,
dimension(numnod), intent(in) ms )

Definition at line 31 of file st_qaprint_nodes.F.

32C============================================================================
33C M o d u l e s
34C-----------------------------------------------
35 USE qa_out_mod
36 USE message_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com04_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER, INTENT(IN) :: ITAB(*),IMERGE(*),MERGE_NODE_TAB(4,*),NMERGE_TOT
50 my_real, INTENT(IN) ::
51 . x(3,numnod),merge_node_tol(*),ms(numnod)
52C--------------------------------------------------
53C L o c a l V a r i a b l e s
54C-----------------------------------------------
55 INTEGER I, J, MY_ID
56 CHARACTER(LEN=NCHARTITLE)::TITR
57 CHARACTER (LEN=255) :: VARNAME
58 DOUBLE PRECISION TEMP_DOUBLE
59C-----------------------------------------------
60C Nodes + merged nodes
61C-----------------------------------------------
62
63 IF (myqakey('NODES')) THEN
64C
65 DO i=1,numnod
66C
67 my_id = itab(i)
68 CALL qaprint('NODE_ID', my_id,0.0_8)
69C
70 DO j=1,3
71 WRITE(varname,'(A,I0)') 'x_',J
72 TEMP_DOUBLE = X(J,I)
73 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
74 END DO
75C
76 END DO ! DO I=1,NUMNOD
77C
78 IF (NB_MERGE_NODE > 0) THEN
79 DO I=1,NB_MERGE_NODE
80 CALL QAPRINT('/merge/node id ',MERGE_NODE_TAB(4,I),0.0_8)
81 CALL QAPRINT('/merge/node TYPE ',MERGE_NODE_TAB(1,I),0.0_8)
82 CALL QAPRINT('/merge/node gr_id ',MERGE_NODE_TAB(3,I),0.0_8)
83 WRITE(VARNAME,'(a,i0)') 'merge_node',I
84 TEMP_DOUBLE = MERGE_NODE_TOL(I)
85 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
86 ENDDO
87C
88 DO I=1,NMERGED
89 MY_ID = ITAB(IMERGE(I))
90 WRITE(VARNAME,'(a,x,i0,x,a)') 'node id',MY_ID,'is merged with'
91 MY_ID = ITAB(IMERGE(NMERGE_TOT+I))
92 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)), MY_ID,0.0_8)
93 ENDDO
94C
95 ENDIF
96C
97 ELSEIF (MYQAKEY('nodes_mass')) THEN
98C
99 DO I=1,NUMNOD
100C
101 MY_ID = ITAB(I)
102 CALL QAPRINT('node_id', MY_ID,0.0_8)
103C
104 WRITE(VARNAME,'(a)') 'mass_'
105 TEMP_DOUBLE = MS(I)
106 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
107C
108 END DO ! DO I=1,NUMNOD
109C
110 END IF
111C-----------------------------------------------
112 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine merge(x, itab, itabm1, cmerge, imerge, imerge2, iadmerge2, nmerge_tot)
Definition merge.F:36
subroutine merge_node(x, itab, itabm1, imerge, imerge2, iadmerge2, nmerge_tot, merge_node_tab, merge_node_tol, nmerge_node_cand, nmerge_node_dest, ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, ixtg, eani, igrnod)
Definition merge_node.F:41
initmumps id
integer, parameter nchartitle
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
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