32
33
34
38
39
40
41#include "implicit_f.inc"
42
43
44
45#include "com04_c.inc"
46
47
48
49 INTEGER, INTENT(IN) :: ITAB(*),IMERGE(*),MERGE_NODE_TAB(4,*),NMERGE_TOT
51 . x(3,numnod),merge_node_tol(*),ms(numnod)
52
53
54
55 INTEGER I, J, MY_ID
56 CHARACTER(LEN=NCHARTITLE)::TITR
57 CHARACTER (LEN=255) :: VARNAME
58 DOUBLE PRECISION TEMP_DOUBLE
59
60
61
62
64
65 DO i=1,numnod
66
67 my_id = itab(i)
68 CALL qaprint(
'NODE_ID', my_id,0.0_8)
69
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
75
76 END DO ! DO I=1,NUMNOD
77
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)
84 TEMP_DOUBLE = MERGE_NODE_TOL(I)
85 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
86 ENDDO
87
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
94
95 ENDIF
96
97 ELSEIF (MYQAKEY('nodes_mass')) THEN
98
99 DO I=1,NUMNOD
100
101 MY_ID = ITAB(I)
102 CALL QAPRINT('node_id', MY_ID,0.0_8)
103
104 WRITE(VARNAME,'(a)') 'mass_'
105 TEMP_DOUBLE = MS(I)
106 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
107
108 END DO ! DO I=1,NUMNOD
109
110 END IF
111
112 RETURN
subroutine merge(x, itab, itabm1, cmerge, imerge, imerge2, iadmerge2, nmerge_tot)
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)
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 ...
subroutine qaprint(name, idin, value)
@purpose print one entry to QA extract file example of call for real print CALL QAPRINT('MY_LABEL',...