42
43
44
45
46
47
48 USE fail_param_mod
54
55
56
57#include "implicit_f.inc"
58
59
60
61#include "units_c.inc"
62
63
64
65 INTEGER ,INTENT(IN) :: FAIL_ID
66 INTEGER ,INTENT(IN) :: MAT_ID
67 INTEGER ,INTENT(IN) :: IRUPT
68 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
69 TYPE(UNIT_TYPE_) ,INTENT(IN) :: UNITAB
70 TYPE(SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(*)
71 TYPE(FAIL_PARAM_) ,INTENT(INOUT) :: FAIL
72
73
74
75 INTEGER :: NANGLE,I,J,K,INFO,REG_FUNC,MFLAG,SFLAG,RATE_FUNC,NFUNC,NUPARAM,NUVAR
76 INTEGER :: IPIV2(2),IPIV3(3)
77 INTEGER ,PARAMETER :: NSIZE = 2
78 INTEGER ,DIMENSION(NSIZE) :: IFUNC
79 my_real :: pthk,ref_siz,ref_siz_unit,epsd0,cjc,rate_scale,ref_rate_unit,
80 . r1,r2,r4,r5,c5,c5_min,theta_myreal
81 my_real,
DIMENSION(:),
ALLOCATABLE :: c1,c2,c3,c4,inst
82 DOUBLE PRECISION A_1(2,2),B_1(2),A_2(3,3),B_2(3),
83 . TRIAX_1_LIN,TRIAX_2_LIN,TRIAX_3_LIN,
84 . TRIAX_4_LIN,TRIAX_5_LIN,TRIAX_1_QUAD,
85 . ,TRIAX_3_QUAD,TRIAX_4_QUAD,
86 . TRIAX_5_QUAD,(10,10),XMIN,YMIN
87 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: THETA,THETA_RAD,Q_X11,Q_X12,Q_X13,
88 . Q_X21,Q_X22,Q_X23,Q_INST
89 DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: X_1,X_2,AMAT,BVEC
90 INTEGER, DIMENSION(:), ALLOCATABLE :: IPIV
91 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
92 DATA triax_1_lin, triax_2_lin, triax_3_lin, triax_4_lin,
93 . triax_5_lin
94 . / -0.33333333, 0.0, 0.33333333, 0.577350269, 0.66666667 /
95 DATA triax_1_quad, triax_2_quad, triax_3_quad,
96 . triax_4_quad, triax_5_quad
97 . / 0.11111111, 0.0, 0.11111111, 0.33333333, 0.44444444 /
98
99 DATA cos2/
100 1 1. ,0. ,0. ,0. ,0. ,0. ,0. ,0. ,0. ,0. ,
101 2 0. ,1. ,0. ,0. ,0. ,0. ,0. ,0. ,0. ,0. ,
102 3 -1. ,0. ,2. ,0. ,0. ,0. ,0. ,0. ,0. ,0. ,
103 4 0. ,-3. ,0. ,4. ,0. ,0. ,0. ,0. ,0. ,0. ,
104 5 1. ,0. ,-8. ,0. ,8. ,0. ,0. ,0. ,0. ,0. ,
105 6 0. ,5. ,0. ,-20. ,0. ,16. ,0. ,0. ,0. ,0. ,
106 7 -1. ,0. ,18. ,0. ,-48. ,0. ,32. ,0. ,0. ,0. ,
107 8 0. ,-7. ,0. ,56. ,0. ,-112.,0. ,64. ,0. ,0. ,
108 9 1. ,0. ,-32. ,0. ,160. ,0. ,-256.,0. ,128. ,0. ,
109 a 0. ,9. ,0. ,-120.,0. ,432. ,0. ,-576 ,0. ,256. /
110
111 is_encrypted = .false.
112 is_available = .false.
113
114
115
116
118
119
120
121
122
123
124
125 CALL hm_get_floatv (
'Pthk' ,pthk ,is_available,lsubmodel,unitab)
126 CALL hm_get_intv (
'MAT_MFLAG' ,mflag ,is_available,lsubmodel
127 CALL hm_get_intv (
'MAT_SFLAG' ,sflag ,is_available,lsubmodel)
128 CALL hm_get_intv (
'MAT_refanglemax',nangle ,is_available,lsubmodel)
129
130 IF (nangle > 10) THEN
131 CALL ancmsg(msgid=2015,msgtype=msgerror,
132 . anmode=aninfo_blind_1,i1=mat_id,c1=titr)
133 ENDIF
134 CALL hm_get_intv (
'fct_IDel' ,reg_func ,is_available,lsubmodel)
135 CALL hm_get_floatv (
'EI_ref' ,ref_siz ,is_available,lsubmodel,unitab)
136
137 IF (pthk == zero) pthk = one - em06
138 pthk =
min(pthk, one)
139 pthk =
max(pthk,-one)
140 IF (sflag == 0) sflag = 2
141
142 IF ((ref_siz == zero).AND.(reg_func > 0)) THEN
144 ref_siz
145 ENDIF
146
147
148
149
150 CALL hm_get_floatv (
'MAT_C5' ,c5 ,is_available,lsubmodel,unitab)
151 CALL hm_get_floatv (
'MAT_EPSD0' ,epsd0 ,is_available,lsubmodel,unitab)
152 CALL hm_get_floatv (
'MAT_CJC' ,cjc ,is_available,lsubmodel,unitab
153 CALL hm_get_intv (
'fct_IDrate',rate_func ,is_available,lsubmodel
154 CALL hm_get_floatv (
'RATE_scale',rate_scale ,is_available,lsubmodel,unitab)
155
156 IF ((rate_scale == zero).AND.(rate_func > 0)) THEN
157 CALL hm_get_floatv_dim('rate_scale
' ,REF_RATE_UNIT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
158 RATE_SCALE = REF_RATE_UNIT*ONE
159 ENDIF
160 IF (RATE_FUNC > 0) THEN
161 CJC = ZERO
162 EPSD0 = ZERO
163 ELSE
164 RATE_SCALE = ZERO
165 ENDIF
166.OR. IF (CJC == ZERO EPSD0 == ZERO) THEN
167 CJC = ZERO
168 EPSD0 = ZERO
169 ENDIF
170!---------------
171! -> Card3
172!---------------
173! Biquad parameter by angle
174.NOT. IF (ALLOCATED(C1)) ALLOCATE(C1(NANGLE))
175.NOT. IF (ALLOCATED(C2)) ALLOCATE(C2(NANGLE))
176.NOT. IF (ALLOCATED(C3)) ALLOCATE(C3(NANGLE))
177.NOT. IF (ALLOCATED(C4)) ALLOCATE(C4(NANGLE))
178 IF (SFLAG == 3) THEN
179.NOT. IF (ALLOCATED(INST)) ALLOCATE(INST(NANGLE))
180 INST = ZERO
181 ENDIF
182 C5_MIN = INFINITY
183 ! Material selector
184 IF (MFLAG == 0) THEN
185 ! Loop over angles (must be equally distributed between 0 and pi/2)
186 DO J = 1, NANGLE
187 CALL HM_GET_FLOAT_ARRAY_INDEX('mat_c1',C1(J),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
188 CALL HM_GET_FLOAT_ARRAY_INDEX('mat_c2',C2(J),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
189 CALL HM_GET_FLOAT_ARRAY_INDEX('mat_c3',C3(J),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
190 CALL HM_GET_FLOAT_ARRAY_INDEX('mat_c4',C4(J),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
191 ! Default values
192 IF (C3(J) == ZERO) C3(J) = 0.6D0
193.AND..AND..AND. IF (C1(J) == ZERO C2(J) == ZERO C4(J) == ZERO C5 == ZERO) THEN
194 C1(J) = 3.5D0*C3(J)
195 C2(J) = 1.6D0*C3(J)
196 C4(J) = 0.6D0*C3(J)
197 C5_MIN = MIN(C5_MIN,1.5D0*C3(J))
198 ENDIF
199 ! If necking instability is activated
200 IF (SFLAG == 3) THEN
201 CALL HM_GET_FLOAT_ARRAY_INDEX('mat_inst',INST(J),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
202 IF (INST(J) <= ZERO) THEN
203 CALL ANCMSG(MSGID=2016,MSGTYPE=MSGWARNING,
204 . ANMODE=ANINFO_BLIND_1,I1=MAT_ID,C1=TITR)
205 SFLAG = 2
206 ELSEIF (INST(J) >= C4(J)) THEN
207 CALL ANCMSG(MSGID=2017,MSGTYPE=MSGWARNING,
208 . ANMODE=ANINFO_BLIND_1,I1=MAT_ID,C1=TITR)
209 SFLAG = 2
210 ENDIF
211 ENDIF
212 ENDDO
213 ELSE
214 ! RX parameters
215 IF (MFLAG == 1) THEN ! Mild Seel (c3 = 0.6)
216 R1 = 3.5D0
217 R2 = 1.6D0
218 R4 = 0.6D0
219 R5 = 1.5D0
220 ELSEIF (MFLAG == 2) THEN ! DP600 (c3 = 0.5)
221 R1 = 4.3D0
222 R2 = 1.4D0
223 R4 = 0.6D0
224 R5 = 1.6D0
225 ELSEIF (MFLAG == 3) THEN ! Boron (c3 = 0.12)
226 R1 = 5.2D0
227 R2 = 3.1D0
228 R4 = 0.8D0
229 R5 = 3.5D0
230 ELSEIF (MFLAG == 4) THEN ! Aluminium AA5182 (c3 = 0.3)
231 R1 = 5.0D0
232 R2 = 1.0D0
233 R4 = 0.4D0
234 R5 = 0.8D0
235 ELSEIF (MFLAG == 5) THEN ! Aluminium AA6082-T6 (c3 = 0.17)
236 R1 = 7.8D0
237 R2 = 3.5D0
238 R4 = 0.6D0
239 R5 = 2.8D0
240 ELSEIF (MFLAG == 6) THEN ! Plastic light_eBody PA6GF30 (c3 = 0.1)
241 R1 = 3.6D0
242 R2 = 0.6D0
243 R4 = 0.5D0
244 R5 = 0.6D0
245 ELSEIF (MFLAG == 7) THEN ! Plastic light_eBody PP T40 ( c3=0.11 )
246 R1 = 10.0D0
247 R2 = 2.7D0
248 R4 = 0.6D0
249 R5 = 0.7D0
250 ELSEIF (MFLAG == 99) THEN ! user scalling factors
251 CALL HM_GET_FLOATV ('mat_r1' ,R1 ,IS_AVAILABLE,LSUBMODEL,UNITAB)
252 CALL HM_GET_FLOATV ('mat_r2' ,R2 ,IS_AVAILABLE,LSUBMODEL,UNITAB)
253 CALL HM_GET_FLOATV ('mat_r4' ,R4 ,IS_AVAILABLE,LSUBMODEL,UNITAB)
254 CALL HM_GET_FLOATV ('mat_r5' ,R5 ,IS_AVAILABLE,LSUBMODEL,UNITAB)
255 ELSE ! ELSE --> Mild Seel
256 R1 = 3.5D0
257 R2 = 1.6D0
258 R4 = 0.6D0
259 R5 = 1.5D0
260 ENDIF
261 ! Loop over angles (must be equally distributed between 0 and pi/2)
262 DO J = 1, NANGLE
263 CALL HM_GET_FLOAT_ARRAY_INDEX('mat_c3' ,C3(J) ,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
264 ! Default values
265 IF (C3(J) == ZERO) THEN
266 IF (MFLAG == 1) THEN
267 C3(J) = 0.6D0
268 ELSEIF (MFLAG == 2) THEN
269 C3(J) = 0.5D0
270 ELSEIF (MFLAG == 3) THEN
271 C3(J) = 0.12D0
272 ELSEIF (MFLAG == 4) THEN
273 C3(J) = 0.3D0
274 ELSEIF (MFLAG == 5) THEN
275 C3(J) = 0.17D0
276 ELSEIF (MFLAG == 6) THEN
277 C3(J) = 0.1D0
278 ELSEIF (MFLAG == 7) THEN
279 C3(J) = 0.11D0
280 ENDIF
281 ENDIF
282 ! Computation of C1,C2,C4,C5
283 C1(J) = R1*C3(J)
284 C2(J) = R2*C3(J)
285 C4(J) = R4*C3(J)
286 C5_MIN = MIN(C5_MIN,R5*C3(J))
287 ! If necking instability is activated
288 IF (SFLAG == 3) THEN
289 CALL HM_GET_FLOAT_ARRAY_INDEX('mat_inst',INST(J),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
290 IF (INST(J) <= ZERO) THEN
291 CALL ANCMSG(MSGID=2016,MSGTYPE=MSGWARNING,
292 . ANMODE=ANINFO_BLIND_1,I1=MAT_ID,C1=TITR)
293 SFLAG = 2
294 ELSEIF (INST(J) >= C4(J)) THEN
295 CALL ANCMSG(MSGID=2017,MSGTYPE=MSGWARNING,
296 . ANMODE=ANINFO_BLIND_1,I1=MAT_ID,C1=TITR)
297 SFLAG = 2
298 ENDIF
299 ENDIF
300 ENDDO
301 ENDIF
302 ! Default value
303 IF (C5 == ZERO) C5 = C5_MIN
304
305
306
307.NOT. IF (ALLOCATED(X_1)) ALLOCATE(X_1(NANGLE,3))
308.NOT. IF (ALLOCATED(X_2)) ALLOCATE(X_2(NANGLE,3))
309 !================================================
310 ! Loop over the angle
311 !================================================
312 DO J = 1,NANGLE
313
314 ! Coefficient for the first parabole
315 ! ---------------------------------------
316 A_1(1,1) = TRIAX_1_LIN
317 A_1(1,2) = TRIAX_1_QUAD
318 A_1(2,1) = TRIAX_3_LIN
319 A_1(2,2) = TRIAX_3_QUAD
320 B_1(1) = C1(J) - C2(J)
321 B_1(2) = C3(J) - C2(J)
322
323 ! Fitting the first quadratic function
324#ifndef WITHOUT_LINALG
325 CALL DGESV(2, 1, A_1, 2, IPIV2, B_1, 2, INFO)
326#else
327 WRITE(6,*) "Error: Blas/Lapack required"
328#endif
329 X_1(J,1) = C2(J)
330 X_1(J,2:3) = B_1(1:2)
331
332 ! Coefficient for the second parabole
333 !----------------------------------------
334 A_2(1,1) = ONE
335 A_2(1,2) = TRIAX_3_LIN
336 A_2(1,3) = TRIAX_3_QUAD
337 A_2(2,1) = ONE
338 A_2(2,2) = TRIAX_4_LIN
339 A_2(2,3) = TRIAX_4_QUAD
340 A_2(3,1) = ONE
341 A_2(3,2) = TRIAX_5_LIN
342 A_2(3,3) = TRIAX_5_QUAD
343 B_2(1) = C3(J)
344 B_2(2) = C4(J)
345 B_2(3) = C5
346
347 ! Fitting the second quadratic function
348#ifndef WITHOUT_LINALG
349 CALL DGESV(3, 1, A_2, 3, IPIV3, B_2, 3, INFO)
350#endif
351 X_2(J,1:3) = B_2(1:3)
352
353 ENDDO
354
355
356
357
358
359.NOT. IF (ALLOCATED(THETA)) ALLOCATE(THETA(NANGLE))
360.NOT. IF (ALLOCATED(THETA_RAD)) ALLOCATE(THETA_RAD(NANGLE))
361
362 ! Computation of angles and check curves
363 DO J = 1, NANGLE
364 IF (NANGLE > 1) THEN
365 THETA(J) = (J-1)*(90.0D0/(NANGLE-1))
366 THETA_RAD(J) = THETA(J)*(PI/180.0D0)
367 ELSE
368 THETA(J) = ZERO
369 THETA_RAD(J) = ZERO
370 ENDIF
371
372 ! Check if minimum of first parabola is negative
373 XMIN = -X_1(J,2)/(TWO*X_1(J,3))
374 YMIN = X_1(J,3)*(XMIN**2) + X_1(J,2)*XMIN + X_1(J,1)
375 IF (YMIN < ZERO) THEN
376 THETA_MYREAL = THETA(J)
377 CALL ANCMSG(MSGID=3002,
378 . MSGTYPE=MSGWARNING,
379 . ANMODE=ANINFO_BLIND_1,
380 . I1=MAT_ID,
381 . C1=TITR,
382 . I2=J,
383 . R1=THETA_MYREAL)
384 ENDIF
385
386 ! Check if minimum of second parabola is negative
387 IF (SFLAG == 1) THEN
388 XMIN = -X_2(J,2)/(TWO*X_2(J,3))
389 YMIN = X_2(J,3)*(XMIN**2) + X_2(J,2)*XMIN + X_2(J,1)
390 IF (YMIN < ZERO) THEN
391 THETA_MYREAL = THETA(J)
392 CALL ANCMSG(MSGID=3003,
393 . MSGTYPE=MSGWARNING,
394 . ANMODE=ANINFO_BLIND_1,
395 . I1=MAT_ID,
396 . C1=TITR,
397 . I2=J,
398 . R1=THETA_MYREAL)
399 ENDIF
400 ENDIF
401
402 ENDDO
403
404 ! Allocation of the A-MATRIX and the Pivot vector
405 ALLOCATE (AMAT(NANGLE,NANGLE),IPIV(NANGLE))
406
407 ! Filling the A-MATRIX
408 DO J = 1,NANGLE
409 DO I = 1,NANGLE
410 AMAT(J,I) = ZERO
411 DO K = 1,I
412 AMAT(J,I) = AMAT(J,I) + COS2(K,I)*(COS(TWO*THETA_RAD(J)))**(K-1)
413 ENDDO
414 ENDDO
415 ENDDO
416
417 ! Allocation of factors
418 ALLOCATE(Q_X11(NANGLE),Q_X12(NANGLE),Q_X13(NANGLE),
419 . Q_X21(NANGLE),Q_X22(NANGLE),Q_X23(NANGLE))
420
421 ! Initialization of tables
422 Q_X11(1:NANGLE) = ZERO
423 Q_X12(1:NANGLE) = ZERO
424 Q_X13(1:NANGLE) = ZERO
425 Q_X21(1:NANGLE) = ZERO
426 Q_X22(1:NANGLE) = ZERO
427 Q_X23(1:NANGLE) = ZERO
428 IF (SFLAG == 3) THEN
429 ALLOCATE(Q_INST(NANGLE))
430 Q_INST(1:NANGLE) = ZERO
431 ENDIF
432
433 ! Filling the B vector with experimental points
434 IF (SFLAG == 3) THEN
435 ALLOCATE (BVEC(NANGLE,7))
436 ELSE
437 ALLOCATE (BVEC(NANGLE,6))
438 ENDIF
439 BVEC(1:NANGLE,1) = X_1(1:NANGLE,1)
440 BVEC(1:NANGLE,2) = X_1(1:NANGLE,2)
441 BVEC(1:NANGLE,3) = X_1(1:NANGLE,3)
442 BVEC(1:NANGLE,4) = X_2(1:NANGLE,1)
443 BVEC(1:NANGLE,5) = X_2(1:NANGLE,2)
444 BVEC(1:NANGLE,6) = X_2(1:NANGLE,3)
445 IF (SFLAG == 3) BVEC(1:NANGLE,7) = INST(1:NANGLE)
446
447 ! Initialization of the Pivot vector
448 IPIV(1:NANGLE) = 0
449
450 ! Solving the A-MATRIX * x = B vector system
451#ifndef WITHOUT_LINALG
452 IF (SFLAG == 3) THEN
453 CALL DGESV(NANGLE, 7, AMAT, NANGLE, IPIV, BVEC, NANGLE, INFO)
454 ELSE
455 CALL DGESV(NANGLE, 6, AMAT, NANGLE, IPIV, BVEC, NANGLE, INFO)
456 ENDIF
457#else
458 WRITE(6,*) "Error: Blas/Lapack required"
459#endif
460
461 ! Recovering the solution
462 Q_X11(1:NANGLE) = BVEC(1:NANGLE,1)
463 Q_X12(1:NANGLE) = BVEC(1:NANGLE,2)
464 Q_X13(1:NANGLE) = BVEC(1:NANGLE,3)
465 Q_X21(1:NANGLE) = BVEC(1:NANGLE,4)
466 Q_X22(1:NANGLE) = BVEC(1:NANGLE,5)
467 Q_X23(1:NANGLE) = BVEC(1:NANGLE,6)
468 IF (SFLAG == 3) Q_INST(1:NANGLE) = BVEC(1:NANGLE,7)
469
470
471 ! -> Number of parameters
472 NUPARAM = 7
473 IF (SFLAG == 3) THEN
474 NUPARAM = NUPARAM + 7*NANGLE
475 ELSE
476 NUPARAM = NUPARAM + 6*NANGLE
477 ENDIF
478 ! -> Number of functions
479 NFUNC = 0
480 IF (RATE_FUNC /= 0) THEN
481 NFUNC = NFUNC + 1
482 IFUNC(NFUNC) = RATE_FUNC
483 ENDIF
484 IF (REG_FUNC /= 0) THEN
485 NFUNC = NFUNC + 1
486 IFUNC(NFUNC) = REG_FUNC
487 ENDIF
488 ! -> Number of user variables
489 NUVAR = 3
490
491
492
493 FAIL%KEYWORD = 'orth-biquad'
494 FAIL%IRUPT = IRUPT
495 FAIL%FAIL_ID = FAIL_ID
496 FAIL%NUPARAM = NUPARAM
497 FAIL%NIPARAM = 0
498 FAIL%NUVAR = NUVAR
499 FAIL%NFUNC = NFUNC
500 FAIL%NTABLE = 0
501 FAIL%NMOD = 0
502 FAIL%PTHK = PTHK
503
504 ALLOCATE (FAIL%UPARAM(FAIL%NUPARAM))
505 ALLOCATE (FAIL%IPARAM(FAIL%NIPARAM))
506 ALLOCATE (FAIL%IFUNC (FAIL%NFUNC))
507 ALLOCATE (FAIL%TABLE (FAIL%NTABLE))
508
509 FAIL%IFUNC(1:NFUNC) = IFUNC(1:NFUNC)
510
511 FAIL%UPARAM(1) = PTHK
512 FAIL%UPARAM(2) = SFLAG
513 FAIL%UPARAM(3) = REF_SIZ
514 FAIL%UPARAM(4) = EPSD0
515 FAIL%UPARAM(5) = CJC
516 FAIL%UPARAM(6) = RATE_SCALE
517 FAIL%UPARAM(7) = NANGLE
518 IF (SFLAG == 3) THEN
519 DO J = 1,NANGLE
520 FAIL%UPARAM(8 + 7*(J-1)) = Q_X11(J)
521 FAIL%UPARAM(9 + 7*(J-1)) = Q_X12(J)
522 FAIL%UPARAM(10 + 7*(J-1)) = Q_X13(J)
523 FAIL%UPARAM(11 + 7*(J-1)) = Q_X21(J)
524 FAIL%UPARAM(12 + 7*(J-1)) = Q_X22(J)
525 FAIL%UPARAM(13 + 7*(J-1)) = Q_X23(J)
526 FAIL%UPARAM(14 + 7*(J-1)) = Q_INST(J)
527 ENDDO
528 ELSE
529 DO J = 1,NANGLE
530 FAIL%UPARAM(8 + 6*(J-1)) = Q_X11(J)
531 FAIL%UPARAM(9 + 6*(J-1)) = Q_X12(J)
532 FAIL%UPARAM(10 + 6*(J-1)) = Q_X13(J)
533 FAIL%UPARAM(11 + 6*(J-1)) = Q_X21(J)
534 FAIL%UPARAM(12 + 6*(J-1)) = Q_X22(J)
535 FAIL%UPARAM(13 + 6*(J-1)) = Q_X23(J)
536 ENDDO
537 ENDIF
538
539
540
541 IF (IS_ENCRYPTED) THEN
542 WRITE(IOUT,'(5x,a,//)')'confidential data'
543 ELSE
544 WRITE(IOUT,1000)
545 IF (MFLAG /= 0) WRITE(IOUT, 1100) MFLAG
546 DO J = 1,NANGLE
547 WRITE(IOUT,1200) THETA(J),C1(J),C2(J),C3(J),C4(J),C5,
548 & X_1(J,3),X_1(J,2),X_1(J,1),X_2(J,3),X_2(J,2),X_2(J,1)
549 IF (SFLAG == 3) WRITE(IOUT, 1900) INST(J)
550 ENDDO
551 WRITE(IOUT,1300) PTHK,SFLAG
552 IF (REG_FUNC > 0) WRITE(IOUT,1400) REG_FUNC,REF_SIZ
553 IF (EPSD0 > ZERO) THEN
554 WRITE(IOUT,1500) EPSD0,CJC
555 ELSEIF (RATE_FUNC > 0) THEN
556 WRITE(IOUT,1600) RATE_FUNC,RATE_SCALE
557 ENDIF
558 WRITE(IOUT,2000)
559 ENDIF
560
561
562
563 IF (ALLOCATED(C1)) DEALLOCATE(C1)
564 IF (ALLOCATED(C2)) DEALLOCATE(C2)
565 IF (ALLOCATED(C3)) DEALLOCATE(C3)
566 IF (ALLOCATED(C4)) DEALLOCATE(C4)
567 IF (ALLOCATED(INST)) DEALLOCATE(INST)
568 IF (ALLOCATED(X_1)) DEALLOCATE(X_1)
569 IF (ALLOCATED(X_2)) DEALLOCATE(X_2)
570 IF (ALLOCATED(THETA)) DEALLOCATE(THETA)
571 IF (ALLOCATED(THETA_RAD)) DEALLOCATE(THETA_RAD)
572 IF (ALLOCATED(Q_X11)) DEALLOCATE(Q_X11)
573 IF (ALLOCATED(Q_X12)) DEALLOCATE(Q_X12)
574 IF (ALLOCATED(Q_X13)) DEALLOCATE(Q_X13)
575 IF (ALLOCATED(Q_X21)) DEALLOCATE(Q_X21)
576 IF (ALLOCATED(Q_X22)) DEALLOCATE(Q_X22)
577 IF (ALLOCATED(Q_X23)) DEALLOCATE(Q_X23)
578 IF (ALLOCATED(Q_INST)) DEALLOCATE(Q_INST)
579 IF (ALLOCATED(AMAT)) DEALLOCATE(AMAT)
580 IF (ALLOCATED(IPIV)) DEALLOCATE(IPIV)
581
582 1000 FORMAT(
583 & 5X,' ------------------------------------------ ',/
584 & 5X,' failure criterion : orthotropic biquad ',/,
585 & 5X,' ------------------------------------------ ',/)
586 1100 FORMAT(
587 & 5X,'material PARAMETER selector . . . . . . . . . . .=',I10)
588 1200 FORMAT(
589 & 5X,'|| failure strains
for angle
',F5.1,' deg
',/,
590 & 5X,' -------------------------------------------------',/,
591 & 5X,' simple compression c1 . . . . . . . . . . . . .=',1PG20.13/
592 & 5X,' shear c2 . . . . . . . . . . . . . . . . . . . .=',1PG20.13/
593 & 5X,' simple tension c3 . . . . . . . . . . . . . . .=',1PG20.13/
594 & 5X,' plane strain c4 . . . . . . . . . . . . . . . .=',1PG20.13/
595 & 5X,' biaxial tension c5 . . . . . . . . . . . . . . .=',1PG20.13/
596 & 5X,' ',/
597 & 5X,' low stress triaxiality parabola PARAMETER a. . .=',1PG20.13/
598 & 5X,' low stress triaxiality parabola PARAMETER b. . .=',1PG20.13/
599 & 5X,' low stress triaxiality parabola PARAMETER c. . .=',1PG20.13/
600 & 5X,' ',/
601 & 5X,' high stress triaxiality parabola PARAMETER d . .=',1PG20.13/
602 & 5X,' high stress triaxiality parabola PARAMETER e . .=',1PG20.13/
603 & 5X,' high stress triaxiality parabola PARAMETER f . .=',1PG20.13/)
604 1300 FORMAT(
605 & 5X,'element deletion :',/,
606 & 5X,'shell element deletion PARAMETER pthickfail. . . .=',1PG20.13,/,
607 & 5X,' > 0.0 : fraction of failed thickness ',/,
608 & 5X,' < 0.0 : fraction of failed intg. points or layers',/,
609 & 5X,'s-flag . . . . . . . . . . . . . . . . . . . . . .=',I10,/)
610 1400 FORMAT(
611 & 5X,'element length regularization used:',/,
612 & 5X,'regularization
FUNCTION id . . . . . . . . . . . .=
',I10,/,
613 & 5X,'reference element length . . . . . . . . . . . . .=',1PG20.13,/)
614 1500 FORMAT(
615 & 5X,'johnson-cook strain-rate dependency:',/,
616 & 5X,'reference strain-rate . . . . . . . . . . . . . .=',1PG20.13,/,
617 & 5X,'johnson-cook parameter . . . . . . . . . . . . . .=',1PG20.13,/)
618 1600 FORMAT(
619 & 5X,'tabulated strain-rate dependency:',/,
620 & 5X,'strain-rate dependency function
id . . . . . . . .=
',I10,/,
621 & 5X,'strain-rate scale factor . . . . . . . . . . . . .=',1PG20.13,/)
622 1900 FORMAT(
623 & 5X,' instability strain . . . . . . . . . . . . . . .=',1PG20.13,//)
624 2000 FORMAT(
625 & 5X,' --------------------------------------------------',//)
626
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)
for(i8=*sizetab-1;i8 >=0;i8--)
integer, parameter nchartitle
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)
1.15.0