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