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, len)

Function/Subroutine Documentation

◆ write_matparam()

subroutine write_matparam ( type(mat_elem_), intent(in) mat_elem,
integer, intent(inout) len )

Definition at line 38 of file write_matparam.F.

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
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
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
write_failparam
subroutine write_failparam(fail, len)
Definition write_failparam.F:31
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:140
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645
write_c_c
void write_c_c(int *w, int *len)
Definition write_routtines.c:591