43
44
45
46 USE fail_param_mod
51
52
53
54#include "implicit_f.inc"
55
56
57
58#include "units_c.inc"
59
60
61
62 INTEGER ,INTENT(IN) :: FAIL_ID
63 INTEGER ,INTENT(IN) :: MAT_ID
64 INTEGER ,INTENT(IN) :: IRUPT
65 CHARACTER ,INTENT(IN) :: TITR*500
66 TYPE(UNIT_TYPE_) ,INTENT(IN) :: UNITAB
67 TYPE(SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(*)
68 TYPE(FAIL_PARAM_) ,INTENT(INOUT) :: FAIL
69
70
71
72 INTEGER J,NINIEVO,FAILIP,ISHEAR,ILEN,NUPARAM,NUVAR,NTABLE
73 INTEGER,DIMENSION(:), ALLOCATABLE ::
74 . INITYPE,EVOTYPE,EVOSHAP,COMPTYP,TAB_ID,TAB_EL
75 my_real :: pthk,length_unit,rate_unit
76 my_real,
DIMENSION(:),
ALLOCATABLE ::
77 . sr_ref,fscale,ini_p1,el_ref,elscal,disp,ener,
alpha
78 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
79
80 is_encrypted = .false.
81 is_available = .false.
82
83
84
86
87
88
89
90
91
92 CALL hm_get_intv (
'NINIEVO' ,ninievo ,is_available,lsubmodel)
93 IF (ninievo == 0) ninievo = 1
94 CALL hm_get_intv (
'ISHEAR' ,ishear ,is_available,lsubmodel)
95 ishear =
min(ishear,1)
96 CALL hm_get_intv (
'ILEN' ,ilen ,is_available,lsubmodel)
98 IF (ilen == 2) THEN
100 . msgtype=msginfo,
101 . anmode=aninfo_blind,
102 . i1=mat_id,
103 . c1=titr)
104 ENDIF
105 CALL hm_get_intv (
'FAILIP' ,failip ,is_available,lsubmodel)
106 IF (failip == 0) failip = 1
107 CALL hm_get_floatv ('pthk
' ,PTHK ,IS_AVAILABLE,LSUBMODEL,UNITAB)
108 IF (PTHK == ZERO) PTHK = EM06
109 PTHK = MIN(PTHK, ONE)
110 PTHK = MAX(PTHK,-ONE)
111!---------------
112! -> Card2
113!---------------
114 ALLOCATE(INITYPE(NINIEVO),EVOTYPE(NINIEVO),EVOSHAP(NINIEVO),COMPTYP(NINIEVO))
115 ALLOCATE(TAB_ID(NINIEVO) ,SR_REF(NINIEVO) ,FSCALE(NINIEVO) ,INI_P1(NINIEVO))
116 ALLOCATE(TAB_EL(NINIEVO) ,EL_REF(NINIEVO) ,ELSCAL(NINIEVO) )
117 ALLOCATE(DISP(NINIEVO) ,ENER(NINIEVO) ,ALPHA(NINIEVO) )
118 INITYPE(1:NINIEVO) = 0
119 EVOTYPE(1:NINIEVO) = 0
120 EVOSHAP(1:NINIEVO) = 0
121 COMPTYP(1:NINIEVO) = 0
122 TAB_ID(1:NINIEVO) = 0
123 TAB_EL(1:NINIEVO) = 0
124 SR_REF(1:NINIEVO) = ZERO
125 FSCALE(1:NINIEVO) = ZERO
126 INI_P1(1:NINIEVO) = ZERO
127 EL_REF(1:NINIEVO) = ZERO
128 ELSCAL(1:NINIEVO) = ZERO
129 DISP(1:NINIEVO) = ZERO
130 ENER(1:NINIEVO) = ZERO
131 ALPHA(1:NINIEVO) = ZERO
132 ! Loop over inievo cards
133 DO J = 1, NINIEVO
134 ! First line
135 CALL HM_GET_INT_ARRAY_INDEX('initype',INITYPE(J),J,IS_AVAILABLE,LSUBMODEL)
136 INITYPE(J) = MIN(INITYPE(J),5)
137 IF (INITYPE(J) == 0) INITYPE(J) = 1
138 CALL HM_GET_INT_ARRAY_INDEX('evotype',EVOTYPE(J),J,IS_AVAILABLE,LSUBMODEL)
139 EVOTYPE(J) = MAX(EVOTYPE(J),0)
140 EVOTYPE(J) = MIN(EVOTYPE(J),2)
141 CALL HM_GET_INT_ARRAY_INDEX('evoshap',EVOSHAP(J),J,IS_AVAILABLE,LSUBMODEL)
142 EVOSHAP(J) = MIN(EVOSHAP(J),2)
143 IF (EVOSHAP(J) == 0) EVOSHAP(J) = 1
144 CALL HM_GET_INT_ARRAY_INDEX('comptyp',COMPTYP(J),J,IS_AVAILABLE,LSUBMODEL)
145 COMPTYP(J) = MIN(COMPTYP(J),2)
146 IF (COMPTYP(J) == 0) COMPTYP(J) = 1
147 ! Second line
148 CALL HM_GET_INT_ARRAY_INDEX ('tab_id',TAB_ID(J),J,IS_AVAILABLE,LSUBMODEL)
149 IF (TAB_ID(J) == 0) THEN
150 CALL ANCMSG(MSGID=2088, MSGTYPE=MSGERROR, ANMODE=ANINFO_BLIND,
151 . I1=MAT_ID,
152 . I2=J)
153 ENDIF
154 CALL HM_GET_FLOAT_ARRAY_INDEX('sr_ref',SR_REF(J),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
155 IF (SR_REF(J) == ZERO) THEN
156 CALL HM_GET_FLOAT_ARRAY_INDEX_DIM('sr_ref' ,RATE_UNIT,J,IS_AVAILABLE, LSUBMODEL, UNITAB)
157 SR_REF(J) = ONE*RATE_UNIT
158 ENDIF
159 CALL HM_GET_FLOAT_ARRAY_INDEX('fscale',FSCALE(J),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
160 IF (FSCALE(J) == ZERO) FSCALE(J) = ONE
161 CALL HM_GET_FLOAT_ARRAY_INDEX('ini_p1',INI_P1(J),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
162 ! Third line
163 CALL HM_GET_INT_ARRAY_INDEX ('tab_el',TAB_EL(J),J,IS_AVAILABLE,LSUBMODEL)
164 CALL HM_GET_FLOAT_ARRAY_INDEX('el_ref',EL_REF(J),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
165 IF (EL_REF(J) == ZERO) THEN
166 CALL HM_GET_FLOAT_ARRAY_INDEX_DIM('el_ref' ,LENGTH_UNIT,J,IS_AVAILABLE, LSUBMODEL, UNITAB)
167 EL_REF(J) = ONE*LENGTH_UNIT
168 ENDIF
169 CALL HM_GET_FLOAT_ARRAY_INDEX('elscal',ELSCAL(J),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
170 IF (ELSCAL(J) == ZERO) ELSCAL(J) = ONE
171 ! Fourth line
172 CALL HM_GET_FLOAT_ARRAY_INDEX('disp' ,DISP(J) ,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
173.AND. IF (EVOTYPE(J) == 1 DISP(J) == ZERO) THEN
174 CALL ANCMSG(MSGID=2089, MSGTYPE=MSGERROR, ANMODE=ANINFO_BLIND,
175 . I1=MAT_ID,
176 . I2=J)
177 ENDIF
178 CALL HM_GET_FLOAT_ARRAY_INDEX('alpha' ,ALPHA(J),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
179 IF (ALPHA(J) == ZERO) ALPHA(J) = ONE
180 CALL HM_GET_FLOAT_ARRAY_INDEX('ener' ,ENER(J) ,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
181.AND. IF (EVOTYPE(J) == 2 ENER(J) == ZERO) THEN
182 CALL ANCMSG(MSGID=2090, MSGTYPE=MSGERROR, ANMODE=ANINFO_BLIND,
183 . I1=MAT_ID,
184 . I2=J)
185 ENDIF
186 ENDDO
187
188
189
190
191 NTABLE = NINIEVO*2
192 ! -> Number of user variables
193 NUVAR = 2 + 3*NINIEVO
194 ! -> Number of parameters
195 NUPARAM = 5 + NINIEVO*14
196
197 FAIL%KEYWORD = 'inievo'
198 FAIL%IRUPT = IRUPT
199 FAIL%FAIL_ID = FAIL_ID
200 FAIL%NUPARAM = NUPARAM
201 FAIL%NIPARAM = 0
202 FAIL%NUVAR = NUVAR
203 FAIL%NFUNC = 0
204 FAIL%NTABLE = NTABLE
205 FAIL%NMOD = 0
206 FAIL%PTHK = PTHK
207
208 ALLOCATE (FAIL%UPARAM(FAIL%NUPARAM))
209 ALLOCATE (FAIL%IPARAM(FAIL%NIPARAM))
210 ALLOCATE (FAIL%IFUNC (FAIL%NFUNC))
211 ALLOCATE (FAIL%TABLE (FAIL%NTABLE))
212
213 FAIL%UPARAM(1) = NINIEVO
214 FAIL%UPARAM(2) = ISHEAR
215 FAIL%UPARAM(3) = ILEN
216 FAIL%UPARAM(4) = FAILIP
217 FAIL%UPARAM(5) = PTHK
218
219 FAIL%TABLE(1:NINIEVO) = TAB_ID(1:NINIEVO)
220 FAIL%TABLE(NINIEVO+1:NINIEVO*2) = TAB_EL(1:NINIEVO)
221
222 DO J = 1,NINIEVO
223 FAIL%UPARAM(6 + 14*(J-1)) = INITYPE(J)
224 FAIL%UPARAM(7 + 14*(J-1)) = EVOTYPE(J)
225 FAIL%UPARAM(8 + 14*(J-1)) = EVOSHAP(J)
226 FAIL%UPARAM(9 + 14*(J-1)) = COMPTYP(J)
227 FAIL%UPARAM(10 + 14*(J-1)) = 0 ! INT_TAB_ID(J)
228 FAIL%UPARAM(11 + 14*(J-1)) = SR_REF(J)
229 FAIL%UPARAM(12 + 14*(J-1)) = FSCALE(J)
230 FAIL%UPARAM(13 + 14*(J-1)) = INI_P1(J)
231 FAIL%UPARAM(14 + 14*(J-1)) = 0 ! INT_TAB_EL(J)
232 FAIL%UPARAM(15 + 14*(J-1)) = EL_REF(J)
233 FAIL%UPARAM(16 + 14*(J-1)) = ELSCAL(J)
234 FAIL%UPARAM(17 + 14*(J-1)) = DISP(J)
235 FAIL%UPARAM(18 + 14*(J-1)) = ALPHA(J)
236 FAIL%UPARAM(19 + 14*(J-1)) = ENER(J)
237 ENDDO
238
239
240
241 IF (IS_ENCRYPTED) THEN
242 WRITE(IOUT,'(5x,a,//)')'confidential data'
243 ELSE
244 WRITE(IOUT,1000)
245 WRITE(IOUT,1100) NINIEVO,ISHEAR,ILEN
246 WRITE(IOUT,1200) FAILIP,PTHK
247 DO J = 1,NINIEVO
248 WRITE (IOUT,1300) J,INITYPE(J),TAB_ID(J),SR_REF(J),FSCALE(J),
249 . INI_P1(J),TAB_EL(J),EL_REF(J),ELSCAL(J)
250 IF (EVOTYPE(J) == 1) THEN
251 IF (EVOSHAP(J) == 1) THEN
252 WRITE (IOUT,1400) EVOTYPE(J),EVOSHAP(J),COMPTYP(J),
253 . DISP(J)
254 ELSEIF (EVOSHAP(J) == 2) THEN
255 WRITE (IOUT,1500) EVOTYPE(J),EVOSHAP(J),COMPTYP(J),
256 . DISP(J),ALPHA(J)
257 ENDIF
258 ELSEIF (EVOTYPE(J) == 2) THEN
259 WRITE (IOUT,1600) EVOTYPE(J),EVOSHAP(J),COMPTYP(J),
260 . ENER(J)
261 ENDIF
262 ENDDO
263 WRITE(IOUT,2000)
264 ENDIF
265
266
267
268 IF (ALLOCATED(INITYPE)) DEALLOCATE(INITYPE)
269 IF (ALLOCATED(EVOTYPE)) DEALLOCATE(EVOTYPE)
270 IF (ALLOCATED(EVOSHAP)) DEALLOCATE(EVOSHAP)
271 IF (ALLOCATED(COMPTYP)) DEALLOCATE(COMPTYP)
272 IF (ALLOCATED(TAB_ID)) DEALLOCATE(TAB_ID)
273 IF (ALLOCATED(TAB_EL)) DEALLOCATE(TAB_EL)
274 IF (ALLOCATED(SR_REF)) DEALLOCATE(SR_REF)
275 IF (ALLOCATED(FSCALE)) DEALLOCATE(FSCALE)
276 IF (ALLOCATED(INI_P1)) DEALLOCATE(INI_P1)
277 IF (ALLOCATED(EL_REF)) DEALLOCATE(EL_REF)
278 IF (ALLOCATED(ELSCAL)) DEALLOCATE(ELSCAL)
279 IF (ALLOCATED(DISP)) DEALLOCATE(DISP)
280 IF (ALLOCATED(ENER)) DEALLOCATE(ENER)
281 IF (ALLOCATED(ALPHA)) DEALLOCATE(ALPHA)
282
283 1000 FORMAT(
284 & 5X,' ---------------------------------------------------- ',/
285 & 5X,' failure criterion : inievo ',/,
286 & 5X,' ---------------------------------------------------- ',/)
287 1100 FORMAT(
288 & 5X,'number of inievo criteria. . . . . . . . . . . . . . . .=',I10,/,
289 & 5X,'transverse shear flag(shells only) . . . . . . . . . .=',I10,/,
290 & 5X,' ishear = 0: transverse shear stress components not considered ',/,
291 & 5X,' ishear = 1: transverse shear stress components considered ',/,
292 & 5X,'element characteristic length flag . . . . . . . . . . .=',I10,/,
293 & 5X,' ilen = 0: initial geometric formulation ',/,
294 & 5X,' ilen = 1: initial critical timestep formulation ',/,
295 & 5X,' ilen = 2: current geometric formulation(shells only)',/)
296 1200 FORMAT(
297 & 5X,'element deletion parameters: ',/,
298 & 5X,'number of failed intg. points prior to solid deletion . =',I10,/,
299 & 5X,'shell element deletion PARAMETER pthickfail . . . . . . =',1PG20.13,/,
300 & 5X,' > 0.0 : fraction of failed thickness ',/,
301 & 5X,' < 0.0 : fraction of failed intg. points or layers ',/)
302 1300 FORMAT(
303 & 5X,'|| inievo criterion number #',I3,/,
304 & 5x,' ------------------------------------------------- ',/,
305 & 5x,'> INITIATION PARAMETERS: ',/,
306 & 5x,'DAMAGE INITIATION TYPE . . . . . . . . . . . . . . . . =',i10,/,
307 & 5x,' TABLE DEFINING PLASTIC STRAIN AT FAILURE WITH: ',/,
308 & 5x,' = 1: TRIAXIALITY VS STRAIN RATE ',/,
309 & 5x,' = 2: SHEAR INFLUENCE VS STRAIN RATE ',/,
310 & 5x,' = 3: PRINC. STRAIN RATES RATIO VS STRAIN RATE (TRIAX > 0.0)',/,
311 & 5x,' = 4: PRINC. STRAIN RATES RATIO VS STRAIN RATE ',/,
312 & 5x,' = 5: STRESS STATE PARAMETER VS STRAIN RATE ',/,
313 & 5x,'INITIATION TABLE IDENTIFIER. . . . . . . . . . . . . . =',i10,/,
314 & 5x,' REFERENCE STRAIN RATE . . . . . . . . . . . . . . .=',1pg20.13/,
315 & 5x,' SCALE FACTOR . . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
316 & 5x,'DAMAGE INITIATION PARAMETER . . . . . . . . . . . . . .=',1pg20.13/,
317 & 5x,' INI. TYPE = 1: NOT USED ',/,
318 & 5x,' INI. TYPE = 2: PRESSURE INFLUENCE PARAMETER ',/,
319 & 5x,' INI. TYPE = 3: DIRECT / INCREMENTAL FORMULATION ',/,
320 & 5x,' INI. TYPE = 4: DIRECT / INCREMENTAL FORMULATION ',/,
321 & 5x,' INI. TYPE = 5: TRIAXIALITY INFLUENCE PARAMETER ',/,
322 & 5x,'ELEMENT SIZE SCALING TABLE IDENTIFIER . . . . . . . . =',i10,/,
323 & 5x,' REFERENCE SIZE . . . . . . . . . . . . . . . . . . .=',1pg20.13/,
324 & 5x,' SCALE FACTOR . . . . . . . . . . . . . . . . . . . .=',1pg20.13/)
325 1400 FORMAT(
326 & 5x,'> EVOLUTION PARAMETERS: ',/,
327 & 5x,'DAMAGE EVOLUTION TYPE . . . . . . . . . . . . . . . . =',i10,/,
328 & 5x,' = 1: PLASTIC DISPLACEMENT ',/,
329 & 5x,' = 2: FRACTURE ENERGY ',/,
330 & 5x,'DAMAGE EVOLUTION SHAPE . . . . . . . . . . . . . . . . =',i10,/,
331 & 5x,' = 1: LINEAR ',/,
332 & 5x,' = 2: EXPONENTIAL ',/,
333 & 5x,'DAMAGE EVOLUTION COMBINATION . . . . . . . . . . . . . =',i10,/,
334 & 5x,' = 1: MAXIMUM DAMAGE ',/,
335 & 5x,' = 2: MULTIPLICATIVE ',/,
336 & 5x,'PLASTIC DISPLACEMENT AT FAILURE . . . . . . . . . . . .=',1pg20.13/)
337 1500 FORMAT(
338 & 5x,'> EVOLUTION PARAMETERS: ',/,
339 & 5x,'DAMAGE EVOLUTION TYPE . . . . . . . . . . . . . . . . =',i10,/,
340 & 5x,' = 1: PLASTIC DISPLACEMENT ',/,
341 & 5x,' = 2: FRACTURE ENERGY ',/,
342 & 5x,'DAMAGE EVOLUTION SHAPE . . . . . . . . . . . . . . . . =',i10,/,
343 & 5x,' = 1: LINEAR ',/,
344 & 5x,' = 2: EXPONENTIAL ',/,
345 & 5x,'DAMAGE EVOLUTION COMBINATION . . . . . . . . . . . . . =',i10,/,
346 & 5x,' = 1: MAXIMUM DAMAGE ',/,
347 & 5x,' = 2: MULTIPLICATIVE ',/,
348 & 5x,'PLASTIC DISPLACEMENT AT FAILURE . . . . . . . . . . . .=',1pg20.13/,
349 & 5x,'EXPONENTIAL EVOLUTION PARAMETER . . . . . . . . . . . .=',1pg20.13/)
350 1600 FORMAT(
351 & 5x,'> EVOLUTION PARAMETERS: ',/,
352 & 5x,'DAMAGE EVOLUTION TYPE . . . . . . . . . . . . . . . . =',i10,/,
353 & 5x,' = 1: PLASTIC DISPLACEMENT ',/,
354 & 5x,' = 2: FRACTURE ENERGY ',/,
355 & 5x,'DAMAGE EVOLUTION SHAPE . . . . . . . . . . . . . . . . =',i10,/,
356 & 5x,' = 1: LINEAR ',/,
357 & 5x,' = 2: EXPONENTIAL ',/,
358 & 5x,'DAMAGE EVOLUTION COMBINATION . . . . . . . . . . . . . =',i10,/,
359 & 5x,' = 1: MAXIMUM DAMAGE ',/,
360 & 5x,' = 2: MULTIPLICATIVE ',/,
361 & 5x,'FRACTURE ENERGY . . . . . . . . . . . . . . . . . . . .=',1pg20.13/)
362 2000 FORMAT(
363 & 5x,' -------------------------------------------------------',//)
364
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)