OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
write_matparam.F File Reference
#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine write_matparam (mat_elem)

Function/Subroutine Documentation

◆ write_matparam()

subroutine write_matparam ( type(mat_elem_), intent(in) mat_elem)

Definition at line 43 of file write_matparam.F.

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