OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_admesh.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_admesh ../starter/source/output/qaprint/st_qaprint_admesh.F
25!||--- called by ------------------------------------------------------
26!|| st_qaprint_driver ../starter/source/output/qaprint/st_qaprint_driver.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!||====================================================================
30 SUBROUTINE st_qaprint_admesh(IPART ,IPADMESH,PADMESH,SH4TREE,SH3TREE,
31 2 IXC ,IXTG ,SH4TRIM,SH3TRIM )
32C============================================================================
33C M o d u l e s
34C-----------------------------------------------
35 USE qa_out_mod
36 USE names_and_titles_mod , ONLY : nchartitle
37 use element_mod , only :nixc,nixtg
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"
46#include "param_c.inc"
47#include "scr17_c.inc"
48#include "remesh_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER, INTENT(IN) :: IPART(LIPART1,*), IPADMESH(KIPADMESH,*)
53 INTEGER, INTENT(IN) :: SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*),
54 . sh4trim(*),sh3trim(*) ,ixc(nixc,*), ixtg(nixtg,*)
55 my_real, INTENT(IN) :: padmesh(kpadmesh,*)
56
57C--------------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER I, MY_ID, N , IP
61 CHARACTER (LEN=255) :: VARNAME
62 DOUBLE PRECISION TEMP_DOUBLE
63C-----------------------------------------------
64C /ADMESH
65C-----------------------------------------------
66 IF (myqakey('ADMESH')) THEN
67
68 IF (nadmesh > 0) THEN
69
70 WRITE(varname,'(A)') 'NADMESH'
71 CALL qaprint(varname(1:len_trim(varname)),nadmesh,0.0_8)
72
73 IF(levelmax /= 0) THEN
74 WRITE(varname,'(A)') 'LEVELMAX'
75 CALL qaprint(varname(1:len_trim(varname)),levelmax,0.0_8)
76 ENDIF
77
78 IF(iadmrule /= 0) THEN
79 WRITE(varname,'(A)') 'IADMRULE'
80 CALL qaprint(varname(1:len_trim(varname)),iadmrule,0.0_8)
81 ENDIF
82
83 IF(iadmstat /= 0) THEN
84 WRITE(varname,'(A)') 'IADMSTAT'
85 CALL qaprint(varname(1:len_trim(varname)),iadmstat,0.0_8)
86 ENDIF
87
88 IF(istatcnd /= 0) THEN
89 WRITE(varname,'(A)') 'ISTATCND'
90 CALL qaprint(varname(1:len_trim(varname)),istatcnd,0.0_8)
91 ENDIF
92
93 IF(iadmerrt /= 0) THEN
94 WRITE(varname,'(A)') 'IADMERRT'
95 CALL qaprint(varname(1:len_trim(varname)),iadmerrt,0.0_8)
96 ENDIF
97
98 IF(dtadmesh /= zero) THEN
99 WRITE(varname,'(A)') 'DTADMESH'
100 temp_double = dtadmesh
101 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
102 ENDIF
103
104 IF(tadmesh /= zero) THEN
105 WRITE(varname,'(A)') 'TADMESH'
106 temp_double = tadmesh
107 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
108 ENDIF
109
110
111 DO ip=1,npart
112C
113 my_id = ipart(4,ip)
114 IF(ipart(10,ip) /= 0) THEN
115C
116 CALL qaprint('PART_ID_ADMESH_', my_id,0.0_8)
117C
118 CALL qaprint('LEVELMAX',ipart(10,ip),0.0_8)
119C
120 DO i=1,kipadmesh
121 WRITE(varname,'(A,I0)') 'IPADMESH_',i
122 IF(ipadmesh(i,ip)/= 0) CALL qaprint(varname(1:len_trim(varname)),ipadmesh(i,ip),0.0_8)
123 ENDDO
124C
125 DO i=1,kpadmesh
126 WRITE(varname,'(A,I0)') 'PADMESH_',i
127 temp_double = padmesh(i,ip)
128 IF(temp_double/= zero) CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
129 ENDDO
130 ENDIF
131C
132 ENDDO
133C
134 DO n=1,numelc
135 CALL qaprint('ELEM_ADMESH_4N_ID_', ixc(nixc,n),0.0_8)
136 DO i=1,ksh4tree
137 WRITE(varname,'(A,I0)') 'SH4TREE_',i
138 IF(sh4tree(i,n)/= 0)CALL qaprint(varname(1:len_trim(varname)),sh4tree(i,n),0.0_8)
139 ENDDO
140 ENDDO
141C
142 DO n=1,numeltg
143 CALL qaprint('ELEM_ADMESH_3N_ID_', ixtg(nixtg,n),0.0_8)
144 DO i=1,ksh3tree
145 WRITE(varname,'(A,I0)') 'SH3TREE_',i
146 IF(sh3tree(i,n)/= 0)CALL qaprint(varname(1:len_trim(varname)),sh3tree(i,n),0.0_8)
147 ENDDO
148 ENDDO
149
150 IF(iadmstat/=0)THEN
151
152 DO n=1,lsh4trim
153 IF(sh4trim(n)/= 0) THEN
154 CALL qaprint('ELEM_ADMESH_STAT_4N_ID_', ixc(nixc,n),0.0_8)
155 WRITE(varname,'(A,I0)') 'SH4TRIM_',n
156 CALL qaprint(varname(1:len_trim(varname)),sh4trim(n),0.0_8)
157 ENDIF
158 ENDDO
159
160 DO n=1,lsh3trim
161 IF(sh3trim(n)/= 0) THEN
162 CALL qaprint('ELEM_ADMESH_STAT_3N_ID_', ixtg(nixtg,n),0.0_8)
163 WRITE(varname,'(A,I0)') 'SH3TRIM_',n
164 CALL qaprint(varname(1:len_trim(varname)),sh3trim(n),0.0_8)
165 ENDIF
166 ENDDO
167
168 ENDIF
169
170 ENDIF
171
172 ENDIF
173C-----------------------------------------------
174 RETURN
175 END
my_real
#define my_real
Definition cppsort.cpp:32
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_admesh
subroutine st_qaprint_admesh(ipart, ipadmesh, padmesh, sh4tree, sh3tree, ixc, ixtg, sh4trim, sh3trim)
Definition st_qaprint_admesh.F:32