OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
write_matparam.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!|| write_matparam ../starter/source/materials/mat/write_matparam.F
25!||--- called by ------------------------------------------------------
26!|| ddsplit ../starter/source/restart/ddsplit/ddsplit.F
27!||--- calls -----------------------------------------------------
28!|| write_ale_rezoning_param ../starter/source/materials/mat/write_ale_rezoning_param.F90
29!|| write_eosparam ../starter/source/materials/mat/write_eosparam.F90
30!|| write_failparam ../starter/source/materials/fail/write_failparam.F
31!|| write_mat_table ../starter/source/materials/tools/write_mat_table.F
32!|| write_thermparam ../starter/source/materials/mat/write_thermparam.F90
33!|| write_viscparam ../starter/source/materials/mat/write_viscparam.F
34!||--- uses -----------------------------------------------------
35!|| write_ale_rezoning_param_mod ../starter/source/materials/mat/write_ale_rezoning_param.F90
36!|| write_therpmaram_mod ../starter/source/materials/mat/write_thermparam.F90
37!||====================================================================
38 SUBROUTINE write_matparam(MAT_ELEM,LEN)
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE mat_elem_mod
43 USE names_and_titles_mod
44 use write_therpmaram_mod
45 use write_ale_rezoning_param_mod , only : write_ale_rezoning_param
46! use write_eosparam_mod , only : write_eosparam
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER ,INTENT(INOUT) :: LEN
55 TYPE(mat_elem_) ,INTENT(IN) :: MAT_ELEM
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER :: I,NUMMAT,IMAT,NUPARAM,NIPARAM,NUMTABL,NFAIL
60 INTEGER :: IAD,NFIX,NFIXR,LENI,LENR,NMOD,MOD
61 INTEGER ,DIMENSION(NCHARTITLE) :: NAME
62 INTEGER ,DIMENSION(:) ,ALLOCATABLE :: IBUF
63 INTEGER :: NBSUBMAT, OLDFORMAT
64 my_real ,DIMENSION(:) ,ALLOCATABLE :: rbuf
65C=======================================================================
66 nfix = 24
67 nummat = mat_elem%NUMMAT
68 len = 0
69 leni = nfix*nummat
70 ALLOCATE (ibuf(leni) )
71
72 ! write integer parameters and flags
73 iad = 0
74 DO imat = 1,nummat
75 ibuf(iad+ 1) = mat_elem%MAT_PARAM(imat)%ILAW
76 ibuf(iad+ 2) = mat_elem%MAT_PARAM(imat)%MAT_ID
77 ibuf(iad+ 3) = mat_elem%MAT_PARAM(imat)%NUPARAM
78 ibuf(iad+ 4) = mat_elem%MAT_PARAM(imat)%NIPARAM
79 ibuf(iad+ 5) = mat_elem%MAT_PARAM(imat)%NFUNC
80 ibuf(iad+ 6) = mat_elem%MAT_PARAM(imat)%NTABLE
81 ibuf(iad+ 7) = mat_elem%MAT_PARAM(imat)%NSUBMAT
82 ibuf(iad+ 8) = mat_elem%MAT_PARAM(imat)%NFAIL
83 ibuf(iad+ 9) = mat_elem%MAT_PARAM(imat)%IVISC
84 ibuf(iad+10) = mat_elem%MAT_PARAM(imat)%IEOS
85 ibuf(iad+11) = mat_elem%MAT_PARAM(imat)%ITHERM
86 ibuf(iad+12) = mat_elem%MAT_PARAM(imat)%IEXPAN
87 ibuf(iad+13) = mat_elem%MAT_PARAM(imat)%IALE
88 ibuf(iad+14) = mat_elem%MAT_PARAM(imat)%ITURB
89 ibuf(iad+15) = mat_elem%MAT_PARAM(imat)%HEAT_FLAG
90 ibuf(iad+16) = mat_elem%MAT_PARAM(imat)%COMPRESSIBILITY
91 ibuf(iad+17) = mat_elem%MAT_PARAM(imat)%SMSTR
92 ibuf(iad+18) = mat_elem%MAT_PARAM(imat)%STRAIN_FORMULATION
93 ibuf(iad+19) = mat_elem%MAT_PARAM(imat)%IPRES
94 ibuf(iad+20) = mat_elem%MAT_PARAM(imat)%ORTHOTROPY
95 ibuf(iad+21) = mat_elem%MAT_PARAM(imat)%NLOC
96 ibuf(iad+22) = mat_elem%MAT_PARAM(imat)%IFAILWAVE
97 ibuf(iad+23) = mat_elem%MAT_PARAM(imat)%IXFEM
98 ibuf(iad+24) = mat_elem%MAT_PARAM(imat)%NMOD
99
100 iad = iad + nfix
101 END DO
102
103 CALL write_i_c(ibuf,leni)
104 len = len + leni
105 DEALLOCATE(ibuf)
106
107 ! write real parameters
108 nfixr = 9
109 lenr = nfixr*nummat
110 iad = 0
111 ALLOCATE (rbuf(lenr) )
112 DO imat = 1,nummat
113 rbuf(iad + 1) = mat_elem%MAT_PARAM(imat)%RHO
114 rbuf(iad + 2) = mat_elem%MAT_PARAM(imat)%RHO0
115 rbuf(iad + 3) = mat_elem%MAT_PARAM(imat)%YOUNG
116 rbuf(iad + 4) = mat_elem%MAT_PARAM(imat)%BULK
117 rbuf(iad + 5) = mat_elem%MAT_PARAM(imat)%SHEAR
118 rbuf(iad + 6) = mat_elem%MAT_PARAM(imat)%NU
119 rbuf(iad + 7) = mat_elem%MAT_PARAM(imat)%STIFF_CONTACT
120 rbuf(iad + 8) = mat_elem%MAT_PARAM(imat)%STIFF_HGLASS
121 rbuf(iad + 9) = mat_elem%MAT_PARAM(imat)%STIFF_TSTEP
122 iad = iad + nfixr
123 END DO
124 CALL write_db(rbuf ,lenr)
125 len = len + lenr
126 DEALLOCATE(rbuf)
127
128 ! write material title
129 DO imat = 1,nummat
130 IF(imat < nummat) THEN
131 DO i=1,nchartitle
132 name(i) = ichar(mat_elem%MAT_PARAM(imat)%TITLE(i:i))
133 END DO
134 ELSE
135 name = 0
136 ENDIF
137 CALL write_c_c(name,nchartitle)
138 END DO
139
140 ! write material parameter array
141 DO imat = 1,nummat
142 nuparam = mat_elem%MAT_PARAM(imat)%NUPARAM
143 niparam = mat_elem%MAT_PARAM(imat)%NIPARAM
144 IF (nuparam > 0) THEN
145 CALL write_db(mat_elem%MAT_PARAM(imat)%UPARAM ,nuparam)
146 END IF
147 IF (niparam > 0) THEN
148 CALL write_i_c(mat_elem%MAT_PARAM(imat)%IPARAM ,niparam)
149 END IF
150 len = len + nuparam + niparam
151 END DO
152
153 ! write function tables 4D
154 DO imat = 1,nummat
155 numtabl = mat_elem%MAT_PARAM(imat)%NTABLE
156 IF (numtabl > 0) THEN
157 CALL write_mat_table(mat_elem%MAT_PARAM(imat)%TABLE, numtabl)
158 len = len + leni + lenr
159 END IF
160 END DO
161
162 ! write viscosity model parameters
163 DO imat = 1,nummat
164 IF (mat_elem%MAT_PARAM(imat)%IVISC > 0) THEN
165 CALL write_viscparam(mat_elem%MAT_PARAM(imat)%VISC,len)
166 END IF
167 END DO
168c
169c write thermal parameters
170c
171 DO imat = 1,nummat
172 CALL write_thermparam(mat_elem%MAT_PARAM(imat)%THERM,len)
173 END DO
174c
175c write parameters of failure models per material
176c
177 DO imat = 1,nummat
178 nfail = mat_elem%MAT_PARAM(imat)%NFAIL
179 IF (nfail > 0) THEN
180 DO i = 1,nfail
181 CALL write_failparam(mat_elem%MAT_PARAM(imat)%FAIL(i),len)
182 END DO
183 END IF
184 END DO
185
186 ! write damage modes
187 DO imat = 1,nummat
188 nmod = mat_elem%MAT_PARAM(imat)%NMOD
189 IF (nmod > 0) THEN
190 DO mod = 1,nmod
191 DO i=1,nchartitle
192 name(i) = ichar(mat_elem%MAT_PARAM(imat)%MODE(mod)(i:i))
193 END DO
194 CALL write_c_c(name,nchartitle)
195 ENDDO
196 ENDIF
197 ENDDO
198
199 ! write eos model parameters
200 DO imat = 1,nummat
201 IF (mat_elem%MAT_PARAM(imat)%IEOS > 0) THEN
202 CALL write_eosparam(mat_elem%MAT_PARAM(imat)%EOS)
203 END IF
204 END DO
205
206
207 ! Write multimaterial buffer
208 ALLOCATE (ibuf(21) ) !< mex is 21 submaterials
209 ALLOCATE (rbuf(21) )
210 DO imat = 1,nummat
211 nbsubmat = mat_elem%MAT_PARAM(imat)%MULTIMAT%NB
212 oldformat = mat_elem%MAT_PARAM(imat)%MULTIMAT%old_data_format
213 ibuf(1) = nbsubmat
214 ibuf(2) = oldformat
215 CALL write_i_c(ibuf, 2)
216 IF(nbsubmat > 0)THEN
217 ibuf(1:nbsubmat) = mat_elem%MAT_PARAM(imat)%MULTIMAT%mid
218 rbuf(1:nbsubmat) = mat_elem%MAT_PARAM(imat)%MULTIMAT%vfrac
219 CALL write_i_c(ibuf, nbsubmat)
220 CALL write_db(rbuf, nbsubmat)
221 ! write eos model parameters
222 IF(oldformat == 1)THEN
223 !embedded EOS parameters
224 DO i = 1,nbsubmat
225 CALL write_eosparam(mat_elem%MAT_PARAM(imat)%MULTIMAT%EOS(i))
226 END DO
227 ENDIF
228 ENDIF
229 ENDDO
230 DEALLOCATE(ibuf)
231 DEALLOCATE(rbuf)
232
233
234
235
236 ! write ALE rezoning parameters
237 DO imat = 1,nummat
238 CALL write_ale_rezoning_param(mat_elem%MAT_PARAM(imat)%REZON)
239 END DO
240
241!-----------
242 RETURN
243 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
write_failparam
subroutine write_failparam(fail, len)
Definition write_failparam.F:31
write_matparam
subroutine write_matparam(mat_elem, len)
Definition write_matparam.F:39
write_viscparam
subroutine write_viscparam(visc, len)
Definition write_viscparam.F:32
write_mat_table
subroutine write_mat_table(table, numtabl)
Definition write_mat_table.F:33
write_db
subroutine write_db(a, n)
Definition write_db.F:142
write_i_c
void write_i_c(int *w, int *len)
Definition write_routines.c:645
write_c_c
void write_c_c(int *w, int *len)
Definition write_routines.c:591