OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_ebcs.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_ebcs ../starter/source/output/qaprint/st_qaprint_ebcs.f
25!||--- called by ------------------------------------------------------
26!|| st_qaprint_driver ../starter/source/output/qaprint/st_qaprint_driver.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| restmod ../starter/share/modules1/restart_mod.F
30!||====================================================================
31 SUBROUTINE st_qaprint_ebcs(EBCS_TAB)
32C-----------------------------------------------
33C M o d u l e s
34C-----------------------------------------------
35 USE qa_out_mod
36 USE ale_ebcs_mod
37 USE restmod
38 USE ebcs_mod
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 TYPE(t_ebcs_tab), TARGET, INTENT(IN) :: EBCS_TAB
48C--------------------------------------------------
49C L o c a l V a r i a b l e s
50C-----------------------------------------------
51 LOGICAL :: OK_QA
52 CHARACTER (LEN=255) :: VARNAME
53 INTEGER :: II, JJ
54 DOUBLE PRECISION :: TMPVAL
55 CLASS(t_ebcs), POINTER :: EBCS
56 CHARACTER(LEN=NCHARTITLE) :: TITLE
57C-----------------------------------------------
58C S o u r c e L i n e s
59C-----------------------------------------------
60 IF(nebcs == 0)RETURN
61
62 ok_qa = myqakey('/EBCS')
63
64 IF (ok_qa) THEN
65 DO ii = 1, nebcs
66 ebcs => ebcs_tab%tab(ii)%poly
67 title = ebcs%title
68 IF(len_trim(title) /= 0)THEN
69 CALL qaprint(ebcs%title,0,0.0_8)
70 ELSE
71 CALL qaprint('EBCS_FAKE_TITLE',0,0.0_8)
72 ENDIF
73 CALL qaprint('EBCS ID ',ebcs%ebcs_id,0.0_8)
74 CALL qaprint('EBCS TYPE ',ebcs%type,0.0_8)
75 CALL qaprint('EBCS SURF_ID ',ebcs%surf_id,0.0_8)
76 CALL qaprint('EBCS NB_NODE ',ebcs%nb_node,0.0_8)
77 CALL qaprint('EBCS NB_ELEM ',ebcs%nb_elem,0.0_8)
78 SELECT TYPE (twf => ebcs)
79 TYPE IS (t_ebcs_pres)
80 CALL qaprint('IPRES ',twf%ipres,0.0_8)
81 CALL qaprint('IRHO ',twf%irho,0.0_8)
82 CALL qaprint('IENER ',twf%iener,0.0_8)
83 CALL qaprint('IVX ',twf%ivx,0.0_8)
84 CALL qaprint('IVY ',twf%ivy,0.0_8)
85 CALL qaprint('IVZ ',twf%ivz,0.0_8)
86 tmpval = twf%c
87 CALL qaprint('C ', 0, tmpval)
88 tmpval = twf%pres
89 CALL qaprint('PRES ', 0, tmpval)
90 tmpval = twf%rho
91 CALL qaprint('RHO ', 0, tmpval)
92 tmpval = twf%ener
93 CALL qaprint('ENER ', 0, tmpval)
94 tmpval = twf%vx
95 CALL qaprint('VX ', 0, tmpval)
96 tmpval = twf%vy
97 CALL qaprint('VY ', 0, tmpval)
98 tmpval = twf%vz
99 CALL qaprint('VZ ', 0, tmpval)
100 tmpval = twf%lcar
101 CALL qaprint('LCAR ',0, tmpval)
102 tmpval = twf%r1
103 CALL qaprint('R1 ', 0, tmpval)
104 tmpval = twf%r2
105 CALL qaprint('R2 ', 0, tmpval)
106 TYPE IS (t_ebcs_valvin)
107 CALL qaprint('IPRES ',twf%ipres,0.0_8)
108 CALL qaprint('IRHO ',twf%irho,0.0_8)
109 CALL qaprint('IENER ',twf%iener,0.0_8)
110 tmpval = twf%c
111 CALL qaprint('C ', 0, tmpval)
112 tmpval = twf%pres
113 CALL qaprint('PRES ', 0, tmpval)
114 tmpval = twf%rho
115 CALL qaprint('RHO ', 0, tmpval)
116 tmpval = twf%ener
117 CALL qaprint('ENER ', 0, tmpval)
118 tmpval = twf%lcar
119 CALL qaprint('LCAR ', 0, tmpval)
120 tmpval = twf%r1
121 CALL qaprint('R1 ', 0, tmpval)
122 tmpval = twf%r2
123 CALL qaprint('R2 ', 0, tmpval)
124 TYPE IS (t_ebcs_valvout)
125 CALL qaprint('IPRES ',twf%ipres,0.0_8)
126 CALL qaprint('IRHO ',twf%irho,0.0_8)
127 CALL qaprint('IENER ',twf%iener,0.0_8)
128 tmpval = twf%c
129 CALL qaprint('C ', 0, tmpval)
130 tmpval = twf%pres
131 CALL qaprint('PRES ', 0, tmpval)
132 tmpval = twf%rho
133 CALL qaprint('RHO ', 0, tmpval)
134 tmpval = twf%ener
135 CALL qaprint('ENER ', 0, tmpval)
136 tmpval = twf%lcar
137 CALL qaprint('LCAR ', 0, tmpval)
138 tmpval = twf%r1
139 CALL qaprint('R1 ', 0, tmpval)
140 tmpval = twf%r2
141 CALL qaprint('R2 ', 0, tmpval)
142 TYPE IS (t_ebcs_gradp0)
143 CALL qaprint('IPRES ',twf%ipres,0.0_8)
144 CALL qaprint('IRHO ',twf%irho,0.0_8)
145 CALL qaprint('IENER ',twf%iener,0.0_8)
146 tmpval = twf%c
147 CALL qaprint('C ', 0, tmpval)
148 tmpval = twf%pres
149 CALL qaprint('PRES ', 0, tmpval)
150 tmpval = twf%rho
151 CALL qaprint('RHO ', 0, tmpval)
152 tmpval = twf%ener
153 CALL qaprint('ENER ', 0, tmpval)
154 tmpval = twf%lcar
155 CALL qaprint('LCAR ', 0, tmpval)
156 tmpval = twf%r1
157 CALL qaprint('R1 ', 0, tmpval)
158 tmpval = twf%r2
159 CALL qaprint('R2 ', 0, tmpval)
160 TYPE IS (t_ebcs_vel)
161 CALL qaprint('IRHO ',twf%irho,0.0_8)
162 CALL qaprint('IENER ',twf%iener,0.0_8)
163 CALL qaprint('IVX ',twf%ivx,0.0_8)
164 CALL qaprint('IVY ',twf%ivy,0.0_8)
165 CALL qaprint('IVZ ',twf%ivz,0.0_8)
166 tmpval = twf%c
167 CALL qaprint('C ', 0, tmpval)
168 tmpval = twf%rho
169 CALL qaprint('RHO ', 0, tmpval)
170 tmpval = twf%ener
171 CALL qaprint('ENER ', 0, tmpval)
172 tmpval = twf%vx
173 CALL qaprint('VX ', 0, tmpval)
174 tmpval = twf%vy
175 CALL qaprint('VY ', 0, tmpval)
176 tmpval = twf%vz
177 CALL qaprint('VZ ', 0, tmpval)
178 tmpval = twf%lcar
179 CALL qaprint('LCAR ', 0, tmpval)
180 tmpval = twf%r1
181 CALL qaprint('R1 ', 0, tmpval)
182 tmpval = twf%r2
183 CALL qaprint('R2 ', 0, tmpval)
184 TYPE IS (t_ebcs_normv)
185 CALL qaprint('IRHO ',twf%irho,0.0_8)
186 CALL qaprint('IENER ',twf%iener,0.0_8)
187 CALL qaprint('IVIMP ',twf%ivimp,0.0_8)
188 tmpval = twf%c
189 CALL qaprint('C ', 0, tmpval)
190 tmpval = twf%rho
191 CALL qaprint('RHO ', 0, tmpval)
192 tmpval = twf%ener
193 CALL qaprint('ENER ', 0, tmpval)
194 tmpval = twf%vimp
195 CALL qaprint('VIMP ',0, tmpval)
196 tmpval = twf%lcar
197 CALL qaprint('LCAR ', 0, tmpval)
198 tmpval = twf%r1
199 CALL qaprint('R1 ', 0, tmpval)
200 tmpval = twf%r2
201 CALL qaprint('R2 ', 0, tmpval)
202 TYPE IS (t_ebcs_inip)
203 tmpval = twf%c
204 CALL qaprint('C ', 0, tmpval)
205 tmpval = twf%rho
206 CALL qaprint('RHO ', 0, tmpval)
207 tmpval = twf%lcar
208 CALL qaprint('LCAR ',0, tmpval)
209 TYPE IS (t_ebcs_iniv)
210 tmpval = twf%c
211 CALL qaprint('C ', 0, tmpval)
212 tmpval = twf%rho
213 CALL qaprint('RHO ', 0, tmpval)
214 tmpval = twf%lcar
215 CALL qaprint('LCAR ', 0, tmpval)
216 TYPE IS (t_ebcs_monvol)
217 CALL qaprint('MONVOLID ',twf%monvol_id,0.0_8)
218 CALL qaprint('SENSORID ',twf%sensor_id,0.0_8)
219 TYPE IS (t_ebcs_inlet)
220 CALL qaprint('FORMULATION ',twf%fvm_inlet_data%formulation,0.0_8)
221 CALL qaprint('VECTOR_VELOCITY ',twf%fvm_inlet_data%vector_velocity,0.0_8)
222 DO jj = 1, 3
223 IF (twf%fvm_inlet_data%func_vel(jj) /= 0) THEN
224 WRITE(varname,'(A,I0)') 'IVEL', jj
225 CALL qaprint(trim(varname),twf%fvm_inlet_data%func_vel(jj),0.0_8)
226 ENDIF
227 ENDDO
228 DO jj = 1, 21
229 IF (twf%fvm_inlet_data%func_alpha(jj) /= 0) THEN
230 WRITE(varname,'(a,i0)') 'ialpha', jj
231 CALL qaprint(trim(varname),twf%fvm_inlet_data%func_alpha(jj),0.0_8)
232 ENDIF
233 ENDDO
234 DO jj = 1, 21
235 IF (twf%fvm_inlet_data%func_rho(jj) /= 0) THEN
236 WRITE(varname,'(A,I0)') 'IRHO', jj
237 CALL qaprint(trim(varname),twf%fvm_inlet_data%func_rho(jj),0.0_8)
238 ENDIF
239 ENDDO
240 DO jj = 1, 21
241 IF (twf%fvm_inlet_data%func_pres(jj) /= 0) THEN
242 WRITE(varname,'(A,I0)') 'Ipres', jj
243 CALL qaprint(trim(varname),twf%fvm_inlet_data%func_pres(jj),0.0_8)
244 ENDIF
245 ENDDO
246 DO jj = 1, 3
247 tmpval = twf%fvm_inlet_data%val_vel(jj)
248 IF (twf%fvm_inlet_data%val_vel(jj) /= zero) THEN
249 WRITE(varname,'(A,I0)') 'FVEL', jj
250 CALL qaprint(trim(varname),0,tmpval)
251 ENDIF
252 ENDDO
253 DO jj = 1, 21
254 tmpval = twf%fvm_inlet_data%val_alpha(jj)
255 IF (twf%fvm_inlet_data%val_alpha(jj) /= zero) THEN
256 WRITE(varname,'(A,I0)') 'FALPHA', jj
257 CALL qaprint(trim(varname),0,tmpval)
258 ENDIF
259 ENDDO
260 DO jj = 1, 21
261 tmpval = twf%fvm_inlet_data%val_rho(jj)
262 IF (twf%fvm_inlet_data%val_rho(jj) /= zero) THEN
263 WRITE(varname,'(A,I0)') 'FRHO', jj
264 CALL qaprint(trim(varname),0,tmpval)
265 ENDIF
266 ENDDO
267 DO jj = 1, 21
268 tmpval = twf%fvm_inlet_data%val_pres(jj)
269 IF (twf%fvm_inlet_data%val_pres(jj) /= zero) THEN
270 WRITE(varname,'(A,I0)') 'Fpres', jj
271 CALL qaprint(trim(varname),0,tmpval)
272 ENDIF
273 ENDDO
274 TYPE IS (t_ebcs_fluxout)
275 !no parameter for this option
276 END SELECT
277 ENDDO
278 ENDIF
279C-----------------------------------------------
280 RETURN
281 END
282
integer nebcs
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
subroutine st_qaprint_ebcs(ebcs_tab)
program starter
Definition starter.F:39