OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_materials.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine st_qaprint_materials (mat_elem, ipm, pm, bufmat)

Function/Subroutine Documentation

◆ st_qaprint_materials()

subroutine st_qaprint_materials ( type(mat_elem_), intent(in) mat_elem,
integer, dimension(npropmi,nummat), intent(in) ipm,
dimension(npropm,nummat), intent(in) pm,
dimension(*), intent(in) bufmat )

Definition at line 31 of file st_qaprint_materials.F.

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
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
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799