38
39
40
41
42
43#include "implicit_f.inc"
44
45
46
47#include "comlock.inc"
48
49
50
51 INTEGER ,INTENT(IN) :: NEL
52 INTEGER ,INTENT(IN) :: NUPARAM
53 INTEGER ,INTENT(IN) :: IOUT
54 INTEGER ,INTENT(IN) :: ISTDO
55 INTEGER ,INTENT(IN) :: NFUNC
56 INTEGER ,INTENT(IN) :: SNPC
57 INTEGER ,INTENT(IN) :: STF
58 INTEGER ,DIMENSION(NEL) ,INTENT(IN) :: NGL
59 INTEGER ,DIMENSION(100) ,INTENT(IN) :: IFUNC
60 INTEGER ,DIMENSION(SNPC) ,INTENT(IN) :: NPF
61 INTEGER ,INTENT(IN) :: NUVAR
62 my_real ,
DIMENSION(STF) ,
INTENT(IN) :: tf
64 my_real ,
DIMENSION(NEL) ,
INTENT(IN) :: al
65 my_real ,
DIMENSION(NUPARAM) ,
INTENT(IN) :: uparam
66 my_real ,
DIMENSION(NEL) ,
INTENT(IN) :: dpla
67 my_real ,
DIMENSION(NEL) ,
INTENT(IN) :: svm
68 my_real ,
DIMENSION(NEL) ,
INTENT(IN) :: pressure
69
70 my_real ,
DIMENSION(NEL) ,
INTENT(INOUT) :: off
71 my_real ,
DIMENSION(NEL) ,
INTENT(INOUT) :: dfmax
72 my_real ,
DIMENSION(NEL) ,
INTENT(INOUT) :: tdel
73 my_real ,
DIMENSION(NEL,NUVAR),
INTENT(INOUT) :: uvar
74 my_real,
DIMENSION(NEL) ,
INTENT(INOUT) :: dmgscl
75
76
77
78 INTEGER I,J,IDEL,IDEV,IFLAG(NEL),INDX(NEL),IADBUF,NINDX,
79 . INDEX(NEL),IR,IFAIL,JJ,MATID,SEL,ICOUP
81 . d1,df,triax,scale,sxx,syy,szz
83 EXTERNAL finter
84 my_real p1x,p1y,s1x,s1y,s2y, a1, b1, c1, ref_el_len, lambda,fac,dcrit,exp
86
87
88 ir = 0
89 eps_fail = -huge(eps_fail)
90 x_1(1) = uparam(1)
91 x_1(2) = uparam(2)
92 x_1(3) = uparam(3)
93 x_2(1) = uparam(4)
94 x_2(2) = uparam(5)
95 x_2(3) = uparam(6)
96 d1 = uparam(7)
97 sel = int(uparam(11)+0.0001)
98 IF (sel == 3) sel = 2
99 ref_el_len = uparam(13)
100 icoup = nint(uparam(14))
101 dcrit = uparam(15)
102 exp = uparam(16)
103
104
105
106
107 IF (nfunc > 0) THEN
108 IF (nuvar == 3) THEN
109 IF (uvar(1,3)==zero) THEN
110 DO i=1,nel
111 uvar(i,3) = al(i)
112 lambda = uvar(i,3) / ref_el_len
113 fac = finter(ifunc(1),lambda,npf,tf,df)
114 uvar(i,3) = fac
115 ENDDO
116 ENDIF
117 ELSEIF (nuvar == 9) THEN
118 IF (uvar(1,9)==zero) THEN
119 DO i=1,nel
120 uvar(i,9) = al(i)
121 lambda = uvar(i,9) / ref_el_len
122 fac = finter(ifunc(1),lambda,npf,tf,df)
123 uvar(i,9) = fac
124 ENDDO
125 ENDIF
126 ENDIF
127 ENDIF
128
129
130 nindx = 0
131
132 DO i=1,nel
133 IF (off(i) == one .AND. dpla(i) > zero) THEN
134 triax = pressure(i) /
max(em20, svm(i))
135 IF (triax<-two_third) triax = -two_third
136 IF (triax>two_third) triax = two_third
137 IF (triax <= third) THEN
138 eps_fail = x_1(1) + x_1(2) * triax + x_1(3) * triax**2
139 IF ((nuvar == 3).AND.(nfunc > 0)) eps_fail = eps_fail* uvar(i,3)
140 IF ((nuvar == 9).AND.(nfunc > 0)) eps_fail = eps_fail* uvar(i,9)
141 ELSE
142 SELECT CASE (sel)
143 CASE(1)
144 eps_fail = x_2(1) + x_2(2) * triax + x_2(3) * triax**2
145 IF ((nuvar == 3).AND.(nfunc > 0))eps_fail = eps_fail * uvar(i,3)
146 IF ((nuvar == 9).AND.(nfunc > 0))eps_fail = eps_fail * uvar(i,9)
147 CASE(2)
148 IF (triax <= one/sqr3) THEN
149 p1x = third
150 p1y = x_1(1) + x_1(2) * p1x + x_1(3) * p1x**2
151 s1x = one/sqr3
152 s1y = x_2(1) + x_2(2) / sqr3 + x_2(3) * (one/sqr3)**2
153 a1 = (p1y - s1y) / (p1x - s1x)**2
154 b1 = -two * a1 * s1x
155 c1 = a1 * s1x**2 + s1y
156 eps_fail = c1 + b1 * triax + a1 * triax**2
157 IF ((nuvar == 3).AND.(nfunc > 0))eps_fail = eps_fail * uvar(i,3)
158 IF ((nuvar == 9).AND.(nfunc > 0))eps_fail = eps_fail * uvar(i,9)
159 ELSE
160 p1x = two * third
161 p1y = x_2(1) + x_2(2) * p1x + x_2(3) * p1x**2
162 s1x = one/sqr3
163 s1y = x_2(1) + x_2(2) / sqr3 + x_2(3) * (one/sqr3)**2
164 a1 = (p1y - s1y) / (p1x - s1x)**2
165 b1 = -two * a1 * s1x
166 c1 = a1 * s1x**2 + s1y
167 eps_fail = c1 + b1 * triax + a1 * triax**2
168
169 IF ((nuvar == 3).AND.(nfunc> 0)) eps_fail = eps_fail * uvar(i,3)
170 IF ((nuvar == 9).AND.(nfunc> 0)) eps_fail = eps_fail * uvar(i,9)
171 ENDIF
172 END SELECT
173 ENDIF
174
175 dfmax(i) = dfmax(i) + dpla(i)/
max(eps_fail,em6)
176 dfmax(i) =
min(one,dfmax(i))
177
178 IF (dfmax(i) >= one) THEN
179 nindx = nindx + 1
180 indx(nindx) = i
181 tdel(i) = time
182 dfmax(i) = one
183 off(i) = four_over_5
184 ENDIF
185 ENDIF
186 ENDDO
187
188
189
190 IF (icoup == 1) THEN
191 DO i = 1,nel
192 IF (dfmax(i) >= dcrit) THEN
193 IF (dcrit < one) THEN
194 dmgscl(i) = one - ((dfmax(i)-dcrit)/
max(one-dcrit,em20))**exp
195 ELSE
196 dmgscl(i) = zero
197 ENDIF
198 ELSE
199 dmgscl(i) = one
200 ENDIF
201 ENDDO
202 ENDIF
203
204 IF (nindx > 0) THEN
205 DO j=1,nindx
206 i = indx(j)
207#include "lockon.inc"
208 WRITE(iout, 1000) ngl(i),time
209 WRITE(istdo,1000) ngl(i),time
210#include "lockoff.inc"
211 END DO
212 END IF
213
214 1000 FORMAT(5x,'FAILURE (BIQUAD) OF BEAM ELEMENT ',i10'AT TIME :',1pe12.4)
215
216 RETURN