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,IP, MY_ID,MY_MAT,IADBUF,NUPARAM,NIPARAM,NFAIL,IVISC,IVAR,
59 . IRUPT,FAIL_ID,FAIL_IP,NUVAR,NFUNCF,NTABF,NMOD,NBMAT,MID
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 MULTIMAT
192c-----------------------------
193 nbmat = mat_elem%MAT_PARAM(my_mat)%MULTIMAT%NB
194 IF (nbmat > 0) THEN
195 DO j=1,nbmat
196 mid = mat_elem%MAT_PARAM(my_mat)%MULTIMAT%MID(j)
197 temp_double = mat_elem%MAT_PARAM(my_mat)%MULTIMAT%VFRAC(j)
198 IF (temp_double /= zero) THEN
199 WRITE(varname,'(A,I0)') 'MID_',j
200 CALL qaprint(varname(1:len_trim(varname)),mid,0.0_8)
201 WRITE(varname,'(A,I0)') 'VFRAC_',j
202 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
203 END IF
204 END DO
205 END IF
206
207c-----------------------------
208 END DO ! MY_MAT
209 END IF
210C-----------------------------------------------------------------------
211 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
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:804