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