OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_materials.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_materials ../starter/source/output/qaprint/st_qaprint_materials.F
25!||--- called by ------------------------------------------------------
26!|| st_qaprint_driver ../starter/source/output/qaprint/st_qaprint_driver.F
27!||--- calls -----------------------------------------------------
28!|| fretitl2 ../starter/source/starter/freform.F
29!||--- uses -----------------------------------------------------
30!||====================================================================
31 SUBROUTINE st_qaprint_materials(MAT_ELEM ,IPM ,PM ,BUFMAT )
32C============================================================================
33C M o d u l e s
34C-----------------------------------------------
35 USE qa_out_mod
36 USE mat_elem_mod
37 USE names_and_titles_mod , ONLY : nchartitle
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"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER, INTENT(IN) :: IPM(NPROPMI,NUMMAT)
52 my_real, INTENT(IN) ::
53 . pm(npropm,nummat), bufmat(*)
54 TYPE(mat_elem_) ,INTENT(IN) :: MAT_ELEM
55C--------------------------------------------------
56C L o c a l V a r i a b l e s
57C-----------------------------------------------
58 INTEGER :: I,J,MY_MAT,IADBUF,NUPARAM,NIPARAM,NFAIL,IVISC,IVAR
59 INTEGER :: IRUPT,FAIL_ID,FAIL_IP,NUVAR,NFUNCF,NTABF,NMOD,NBMAT,MID,IEOS
60 CHARACTER(LEN=NCHARTITLE) :: TITR
61 CHARACTER (LEN=255) :: VARNAME
62 DOUBLE PRECISION TEMP_DOUBLE,PTHK
63 LOGICAL :: OK_QA
64C-----------------------------------------------
65 ok_qa = myqakey('MATERIALS')
66 IF (ok_qa) THEN
67 DO my_mat=1,nummat-1 ! Do not write global material
68 CALL fretitl2(titr,ipm(npropmi-ltitr+1,my_mat),ltitr)
69 titr = mat_elem%MAT_PARAM(my_mat)%TITLE
70
71C Le Titr du MAT sert de nom de la variable dans le ref.extract , suivi de l'ID du MAT
72C 2 MATs peuvent avoir le meme titre
73 IF(len_trim(titr)/=0)THEN
74 CALL qaprint(titr(1:len_trim(titr)),ipm(1,my_mat),0.0_8)
75 ELSE
76 CALL qaprint('A_MAT_FAKE_NAME',ipm(1,my_mat),0.0_8)
77 END IF
78 DO i=1,npropmi-ltitr ! si on ne peut pas tester une chaine de caracteres, do i=1,npropmi
79 IF(ipm(i,my_mat) /=0)THEN
80C
81C VARNAME: variable name in ref.extract (without blanks)
82 WRITE(varname,'(A,I0)') 'IPM_',i ! IPM(11) => 'IPM_11'
83 CALL qaprint(varname(1:len_trim(varname)),ipm(i,my_mat),0.0_8)
84 END IF
85 END DO
86 DO i=1,npropm
87 IF(pm(i,my_mat)/=zero)THEN
88C
89C VARNAME: variable name in ref.extract (without blanks)
90 WRITE(varname,'(A,I0)') 'PM_',i
91 temp_double = pm(i,my_mat)
92 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
93 END IF
94 END DO
95 iadbuf =ipm(7,my_mat)
96 nuparam=ipm(9,my_mat)
97 DO i=1,nuparam
98 IF(bufmat(iadbuf+i-1)/=zero)THEN
99C
100C VARNAME: variable name in ref.extract (without blanks)
101 WRITE(varname,'(A,I0)') 'BUFMAT_',i
102 temp_double = bufmat(iadbuf+i-1)
103 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
104 END IF
105 END DO
106c-----------------------------
107c MATERIAL FAILURE MODELS
108c-----------------------------
109 nfail = mat_elem%MAT_PARAM(my_mat)%NFAIL
110 IF (nfail > 0) THEN
111 CALL qaprint('NUMBER OF FAILURE MODELS',nfail,0.0_8)
112c
113 DO i=1,nfail
114 irupt = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%IRUPT
115 fail_id = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%FAIL_ID
116 nuparam = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%NUPARAM
117 niparam = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%NIPARAM
118 nuvar = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%NUVAR
119 nfuncf = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%NFUNC
120 ntabf = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%NTABLE
121 nmod = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%NMOD
122 fail_ip = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%FAIL_IP
123 pthk = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%PTHK
124c
125 CALL qaprint(' FAIL MODEL TYPE',irupt,0.0_8)
126 CALL qaprint(' FAIL_ID',fail_id,0.0_8)
127 CALL qaprint(' FAIL_IP',fail_ip,0.0_8)
128 CALL qaprint(' PTHK',0,pthk)
129 CALL qaprint(' NUMBER OF STATE VARIABLES',nuvar,0.0_8)
130 CALL qaprint(' NUMBER OF FAILURE MODES',nmod,0.0_8)
131c
132 CALL qaprint(' NUPARAM',nuparam,0.0_8)
133 DO j=1,nuparam
134 temp_double = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%UPARAM(j)
135 IF (temp_double /= zero) THEN
136 WRITE(varname,'(A,I0,A,I0)') 'UPARF_',i,'_',j
137 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
138 END IF
139 END DO
140 CALL qaprint(' NIPARAM',niparam,0.0_8)
141 DO j=1,niparam
142 ivar = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%IPARAM(j)
143 IF (ivar /= 0) THEN
144 WRITE(varname,'(A,I0)') 'IPARF_',j
145 CALL qaprint(varname(1:len_trim(varname)),ivar,0.0_8)
146 END IF
147 END DO
148 CALL qaprint(' NFUNC',nfuncf,0.0_8)
149 DO j=1,nfuncf
150 ivar = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%IFUNC(j)
151 IF (ivar /= 0) THEN
152 WRITE(varname,'(A,I0)') 'IFUNC_',j
153 CALL qaprint(varname(1:len_trim(varname)),ivar,0.0_8)
154 END IF
155 END DO
156 CALL qaprint(' ntable',NTABF,0.0_8)
157 DO J=1,NTABF
158 IVAR = MAT_ELEM%MAT_PARAM(MY_MAT)%FAIL(I)%TABLE(J)
159 IF (IVAR /= 0) THEN
160 WRITE(VARNAME,'(a,i0)') 'table_',J
161 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IVAR,0.0_8)
162 END IF
163 END DO
164 END DO ! NFAIL
165 END IF ! NFAIL > 0
166c-----------------------------
167c UPARAM of /VISC
168c-----------------------------
169 IVISC = MAT_ELEM%MAT_PARAM(MY_MAT)%IVISC
170 IF (IVISC > 0) THEN
171 CALL QAPRINT('** visc_model',I,0.0_8)
172 NUPARAM = MAT_ELEM%MAT_PARAM(MY_MAT)%VISC%NUPARAM
173 NIPARAM = MAT_ELEM%MAT_PARAM(MY_MAT)%VISC%NIPARAM
174 DO J=1,NUPARAM
175 TEMP_DOUBLE = MAT_ELEM%MAT_PARAM(MY_MAT)%VISC%UPARAM(J)
176 IF (TEMP_DOUBLE /= ZERO) THEN
177 WRITE(VARNAME,'(a,i0)') 'uparv_',j
178 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
179 END IF
180 END DO
181 DO j=1,niparam
182 ivar = mat_elem%MAT_PARAM(my_mat)%VISC%IPARAM(j)
183 IF (ivar /= 0) THEN
184 WRITE(varname,'(A,I0)') 'IPARV_',j
185 CALL qaprint(varname(1:len_trim(varname)),ivar,0.0_8)
186 END IF
187 END DO
188 END IF
189
190c-----------------------------
191c /EOS parameters
192c-----------------------------
193 ieos = mat_elem%MAT_PARAM(my_mat)%IEOS
194 IF (ieos > 0) THEN
195
196 ! 1 ! POLYNOMIAL !
197 ! 2 ! GRUNEISEN !
198 ! 3 ! TILLOTSON !
199 ! 4 ! PUFF !
200 ! 5 ! SESAME !
201 ! 6 ! NOBLE-ABEL ! 2017.0
202 ! 7 ! IDEAL GAS ! 2018.0
203 ! 8 ! MUNAGHAN ! 2018.0
204 ! 9 ! OSBORNE ! 2018.0
205 ! 10 ! STIFFENED GAS ! 2018.0
206 ! 11 ! LSZK ! 2018.0
207 ! 12 ! POWDER-BURN ! 2019.1
208 ! 13 ! COMPACTION ! 2019.1
209 ! 14 ! NASG ! 2020.0
210 ! 15 ! JWL ! internal use : /INIMAP
211 ! 16 ! IDEALGAS_VT ! 2022.0
212 ! 17 ! TABULATED ! 2022.2
213 ! 18 ! LINEAR ! 2019.0
214 ! 19 ! EXPONENTIAL ! 2024.1
215 ! 20 ! COMPACTION2 ! 2025.1
216 ! 21 ! COMPACTION_TAB ! 2026.0
217 !------------------------------------!
218
219
220 SELECT CASE (ieos)
221 CASE(1)
222 CALL qaprint('** EOS_MODEL > POLYNOMIAL',ieos,0.0_8)
223 CASE(2)
224 CALL qaprint('** EOS_MODEL > GRUNEISEN',ieos,0.0_8)
225 CASE(3)
226 CALL qaprint('** EOS_MODEL > TILLOTSON',ieos,0.0_8)
227 CASE(4)
228 CALL qaprint('** EOS_MODEL > PUFF',ieos,0.0_8)
229 CASE(5)
230 CALL qaprint('** EOS_MODEL > SESAME',ieos,0.0_8)
231 CASE(6)
232 CALL qaprint('** EOS_MODEL > NOBLE-ABEL',ieos,0.0_8)
233 CASE(7)
234 CALL qaprint('** EOS_MODEL > IDEAL-GAS',ieos,0.0_8)
235 CASE(8)
236 CALL qaprint('** EOS_MODEL > MUNAGHAN',ieos,0.0_8)
237 CASE(9)
238 CALL qaprint('** EOS_MODEL > OSBORNE',ieos,0.0_8)
239 CASE(10)
240 CALL qaprint('** EOS_MODEL > STIFFENED-GAS',ieos,0.0_8)
241 CASE(11)
242 CALL qaprint('** EOS_MODEL > LSZK',ieos,0.0_8)
243 CASE(12)
244 CALL qaprint('** EOS_MODEL > POWDER-BURN',ieos,0.0_8)
245 CASE(13)
246 CALL qaprint('** EOS_MODEL > COMPACTION',ieos,0.0_8)
247 CASE(14)
248 CALL qaprint('** EOS_MODEL > NASG',ieos,0.0_8)
249 CASE(15)
250 CALL qaprint('** EOS_MODEL > JWL',ieos,0.0_8)
251 CASE(16)
252 CALL qaprint('** EOS_MODEL > IDEAL-GAS-VT',ieos,0.0_8)
253 CASE(17)
254 CALL qaprint('** EOS_MODEL > TABULATED',ieos,0.0_8)
255 CASE(18)
256 CALL qaprint('** EOS_MODEL > LINEAR',ieos,0.0_8)
257 CASE(19)
258 CALL qaprint('** EOS_MODEL > EXPONENTIAL',ieos,0.0_8)
259 CASE(20)
260 CALL qaprint('** EOS_MODEL > COMPACTION2',ieos,0.0_8)
261 CASE(21)
262 CALL qaprint('** EOS_MODEL > COMPACTION_TAB',ieos,0.0_8)
263 CASE DEFAULT
264 CALL qaprint('** EOS_MODEL ',ieos,0.0_8)
265 END SELECT
266 nuparam = mat_elem%MAT_PARAM(my_mat)%EOS%NUPARAM
267 niparam = mat_elem%MAT_PARAM(my_mat)%EOS%NIPARAM
268 nfuncf = mat_elem%MAT_PARAM(my_mat)%EOS%NFUNC
269 ntabf = mat_elem%MAT_PARAM(my_mat)%EOS%NTABLE
270 IF(nuparam > 0) CALL qaprint('EOS_NUPARAM',nuparam,0.0_8)
271 IF(niparam > 0) CALL qaprint('EOS_NIPARAM',niparam,0.0_8)
272 IF(nfuncf > 0) CALL qaprint('EOS_NFUNCF',nfuncf,0.0_8)
273 IF(ntabf > 0) CALL qaprint('EOS_NTABF',ntabf,0.0_8)
274 DO j=1,nuparam
275 temp_double = mat_elem%MAT_PARAM(my_mat)%EOS%UPARAM(j)
276 IF (temp_double /= zero) THEN
277 WRITE(varname,'(A,I0)') 'EOS_UPARAM_',j
278 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
279 END IF
280 END DO
281 DO j=1,niparam
282 ivar = mat_elem%MAT_PARAM(my_mat)%EOS%IPARAM(j)
283 IF (ivar /= 0) THEN
284 WRITE(varname,'(A,I0)') 'EOS_IPARAM_',j
285 CALL qaprint(varname(1:len_trim(varname)),ivar,0.0_8)
286 END IF
287 END DO
288 DO j=1,nfuncf
289 ivar = mat_elem%MAT_PARAM(my_mat)%EOS%FUNC(j)
290 IF (ivar /= 0) THEN
291 WRITE(varname,'(A,I0)') 'EOS_FUNC_',j
292 CALL qaprint(varname(1:len_trim(varname)),ivar,0.0_8)
293 END IF
294 END DO
295 DO j=1,ntabf
296 ivar = mat_elem%MAT_PARAM(my_mat)%EOS%TABLE(j)%notable
297 IF (ivar /= 0) THEN
298 WRITE(varname,'(A,I0)') 'EOS_TABLE_',j
299 CALL qaprint(varname(1:len_trim(varname)),ivar,0.0_8)
300 END IF
301 END DO
302 END IF
303
304c-----------------------------
305c MULTIMAT
306c-----------------------------
307 nbmat = mat_elem%MAT_PARAM(my_mat)%MULTIMAT%NB
308 IF (nbmat > 0) THEN
309 DO j=1,nbmat
310 mid = mat_elem%MAT_PARAM(my_mat)%MULTIMAT%MID(j)
311 temp_double = mat_elem%MAT_PARAM(my_mat)%MULTIMAT%VFRAC(j)
312 IF (temp_double /= zero) THEN
313 WRITE(varname,'(A,I0)') 'MID_',j
314 CALL qaprint(varname(1:len_trim(varname)),mid,0.0_8)
315 WRITE(varname,'(A,I0)') 'VFRAC_',j
316 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
317 END IF
318 END DO
319 END IF
320
321c-----------------------------
322 END DO ! MY_MAT
323 END IF
324C-----------------------------------------------------------------------
325 RETURN
326 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_materials
subroutine st_qaprint_materials(mat_elem, ipm, pm, bufmat)
Definition st_qaprint_materials.F:32
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799