OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
r1def3.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "units_c.inc"
#include "scr17_c.inc"
#include "scr14_c.inc"
#include "param_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "com01_c.inc"
#include "impl1_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine r1def3 (python, geo, f, al0, e, dl, npf, tf, off, dpl, fep, dpl2, anim, ipos, igeo, al0_err, x1dp, x2dp, v, yield, ngl, mgn, ex, ey, ez, xk, xm, xc, ak, nc1, nc2, nuvar, uvar, dl0, nel, nft, stf, sanin, iresp, snpc)

Function/Subroutine Documentation

◆ r1def3()

subroutine r1def3 ( type(python_) python,
geo,
f,
al0,
e,
dl,
integer, dimension(*) npf,
tf,
off,
dpl,
fep,
dpl2,
anim,
ipos,
integer, dimension(npropgi,*) igeo,
al0_err,
double precision, dimension(3,*) x1dp,
double precision, dimension(3,*) x2dp,
v,
yield,
integer, dimension(*) ngl,
integer, dimension(*) mgn,
ex,
ey,
ez,
xk,
xm,
xc,
ak,
integer, dimension(*) nc1,
integer, dimension(*) nc2,
integer nuvar,
target uvar,
dl0,
integer, intent(in) nel,
integer, intent(in) nft,
integer, intent(in) stf,
integer, intent(in) sanin,
integer, intent(in) iresp,
integer, intent(in) snpc )
Parameters
[in]stfSize of TF
[in]saninSize of ANIM
[in]irespSingle precision flag
[in]snpcSize of NPF

Definition at line 33 of file r1def3.F.

44C-----------------------------------------------
45 USE python_funct_mod
46 USE redef3_mod
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51#include "comlock.inc"
52C-----------------------------------------------
53C G l o b a l P a r a m e t e r s
54C-----------------------------------------------
55#include "mvsiz_p.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "units_c.inc"
60#include "scr17_c.inc"
61#include "scr14_c.inc"
62#include "param_c.inc"
63#include "com04_c.inc"
64#include "com08_c.inc"
65#include "com01_c.inc"
66#include "impl1_c.inc"
67C-----------------------------------------------
68C D u m m y A r g u m e n t s
69C-----------------------------------------------
70 type(python_) :: PYTHON
71 INTEGER, INTENT(IN) :: STF !< Size of TF
72 INTEGER, INTENT(IN) :: SANIN !< Size of ANIM
73 INTEGER, INTENT(IN) :: NFT
74 INTEGER, INTENT(IN) :: NEL
75 INTEGER, INTENT(IN) :: IRESP !< Single precision flag
76 INTEGER, INTENT(IN) :: SNPC !< Size of NPF
77 INTEGER NPF(*),IGEO(NPROPGI,*),NGL(*),MGN(*),
78 . NC1(*),NC2(*),NUVAR
79C REAL
80 my_real
81 . geo(npropg,*), f(*), al0(*), e(*), dl(*), tf(stf), off(*),
82 . dpl(*), dpl2(*), fep(*),anim(sanin),ipos(*),v(3,*),
83 . al0_err(mvsiz),yield(*),ex(mvsiz),ey(mvsiz),ez(mvsiz),
84 . xk(mvsiz),xm(mvsiz),xc(mvsiz),ak(mvsiz),uvar(nuvar,*),dl0(*)
85 DOUBLE PRECISION X1DP(3,*),X2DP(3,*)
86 TARGET :: uvar
87C-----------------------------------------------
88C L o c a l V a r i a b l e s
89C-----------------------------------------------
90 INTEGER IECROU(MVSIZ),
91 . IFUNC(MVSIZ), IFV(MVSIZ), IFUNC2(MVSIZ), I, J, ILENG,
92 . NINDX, INDX(MVSIZ), IFUNC3(MVSIZ)
93C REAL
94 my_real
95 . dlold(mvsiz),
96 . b(mvsiz), d(mvsiz), dmn(mvsiz),dmx(mvsiz),
97 . xl0(mvsiz),dv(mvsiz),ff(mvsiz),lscale(mvsiz),ee(mvsiz),
98 . gf3(mvsiz),epla(mvsiz)
99 my_real
100 . sum ,vx21,vy21,vz21,vl21,not_used,not_used2(2)
101 my_real :: max_slope(mvsiz)
102 DOUBLE PRECISION EXDP(MVSIZ),EYDP(MVSIZ),EZDP(MVSIZ),
103 . AL0DP(MVSIZ),ALDP(MVSIZ)
104 my_real ,DIMENSION(:), POINTER :: xx_old
105 TARGET :: not_used2
106C-----------------------------------------------
107C
108 not_used = zero
109 not_used2 = zero
110C
111 DO i=1,nel
112 epla(i)=zero
113 xm(i)=geo(1,mgn(i))
114 xk(i)=geo(2,mgn(i))
115 xc(i)=geo(3,mgn(i))
116c XC(I)=GEO(3,MGN(I)) + GEO(141,MGN(I)) ! +max slope of h
117 iecrou(i)=nint(geo(7,mgn(i)))
118 ak(i) =geo(10,mgn(i))
119 b(i) =geo(11,mgn(i))
120 d(i) =geo(13,mgn(i))
121 ee(i) =geo(40 ,mgn(i))
122 gf3(i) =geo(132,mgn(i))
123 ff(i) =geo(18 ,mgn(i))
124 dmn(i) =geo(15,mgn(i))
125 dmx(i) =geo(16,mgn(i))
126 lscale(i)= geo(39 ,mgn(i))
127 ifunc(i) =igeo(101,mgn(i))
128 ifv(i) =igeo(102,mgn(i))
129 ifunc2(i)=igeo(103,mgn(i))
130 ifunc3(i)=igeo(119,mgn(i))
131 max_slope(i) = geo(141,mgn(i))
132 ENDDO
133C
134 DO i=1,nel
135 exdp(i)=x2dp(1,i)-x1dp(1,i)
136 eydp(i)=x2dp(2,i)-x1dp(2,i)
137 ezdp(i)=x2dp(3,i)-x1dp(3,i)
138 dlold(i)=dl(i)
139 aldp(i)=sqrt(exdp(i)*exdp(i)+eydp(i)*eydp(i)+ezdp(i)*ezdp(i))
140 ENDDO
141!
142 IF (inispri /= 0 .and. tt == zero) THEN
143 DO i=1,nel
144 dlold(i)=dl0(i)
145 ENDDO
146 ENDIF
147!
148 IF (inispri /= 0 .and. tt == zero) THEN
149 DO i=1,nel
150 xl0(i)= al0(i)
151! if not initialized length
152 IF (xl0(i) == zero) xl0(i) = aldp(i)
153 ENDDO
154 ENDIF
155!
156 IF (tt == zero) THEN
157 DO i=1,nel
158 al0(i)=aldp(i) ! cast double vers My_real
159 ENDDO
160 ENDIF
161C
162 IF (scodver >= 101) THEN
163 IF (tt == zero) THEN
164 DO i=1,nel
165 al0_err(i)=aldp(i)-al0(i) ! difference entre double et My_real
166 ENDDO
167 ENDIF
168 ENDIF
169!
170 IF ( inispri /= 0 .and. tt == zero) THEN
171 DO i=1,nel
172 al0(i)= xl0(i)
173 ENDDO
174 ENDIF
175!
176 DO i=1,nel
177 al0dp(i) = al0(i) ! cast My_real en double
178 ENDDO
179!
180 IF (scodver >= 101) THEN
181 DO i=1,nel
182 al0dp(i) = al0dp(i) + al0_err(i) ! AL_DP doit tre recalcul ainsi afin de garantir la coh rence absolue entre AL0_DP et AL_DP
183 ENDDO
184 ENDIF
185C
186 DO i=1,nel
187 sum = max(aldp(i),em15)
188 exdp(i)= exdp(i)/sum
189 eydp(i)= eydp(i)/sum
190 ezdp(i)= ezdp(i)/sum
191 ex(i)=exdp(i)
192 ey(i)=eydp(i)
193 ez(i)=ezdp(i)
194 ENDDO
195C
196 IF (ismdisp > 0) THEN
197 DO i=1,nel
198 vx21 = v(1,nc2(i)) - v(1,nc1(i))
199 vy21 = v(2,nc2(i)) - v(2,nc1(i))
200 vz21 = v(3,nc2(i)) - v(3,nc1(i))
201 vl21 = vx21*ex(i)+vy21*ey(i)+vz21*ez(i)
202 dl(i)= dlold(i)+vl21*dt1
203 ENDDO
204 ELSE
205 DO i=1,nel
206 dl(i)= (aldp(i)-al0dp(i))
207 ENDDO
208 ENDIF !(ISMDISP>0) THEN
209C
210 DO i=1,nel
211 ileng=nint(geo(93,mgn(i)))
212 IF (ileng /= 0) THEN
213 xl0(i)=al0dp(i)
214 ELSE
215 xl0(i)=one
216 ENDIF
217 ENDDO
218C
219 IF (nuvar > 0) THEN
220 xx_old => uvar(1,1:nel)
221 ELSE
222 xx_old => not_used2
223 ENDIF
224 CALL redef3(python,
225 1 f, xk, dl, fep,
226 2 dlold, dpl, tf, npf,
227 3 xc, off, e, dpl2,
228 4 anim, anim_fe(11),ipos,
229 5 xl0, dmn, dmx, dv,
230 6 ff, lscale, ee, gf3,
231 7 ifunc3, yield, aldp, ak,
232 8 b, d, iecrou, ifunc,
233 9 ifv, ifunc2, epla, xx_old,
234 a nel, nft, stf, sanin,
235 b dt1, iresp, impl_s, idyna,
236 c snpc, max_slope=max_slope)
237 nindx = 0
238 DO i=1,nel
239 IF (off(i) == one .AND. dmx(i) /= zero .AND. dmn(i) /= zero) THEN
240 IF (dl(i) > dmx(i) .OR. dl(i) < dmn(i)) THEN
241 off(i)=zero
242 nindx = nindx + 1
243 indx(nindx) = i
244 idel7nok = 1
245 ENDIF
246 ENDIF
247 ENDDO
248 DO j=1,nindx
249 i = indx(j)
250#include "lockon.inc"
251 WRITE(iout, 1000) ngl(i)
252 WRITE(istdo,1100) ngl(i),tt
253#include "lockoff.inc"
254 ENDDO
255 DO i=1,nel
256 xm(i)=xm(i)*xl0(i)
257 xk(i)=xk(i)/xl0(i)
258C--- for time step compute adding +max slope of h
259C XC(I)=(XC(I)+GEO(141,MGN(I)))/XL0(I)
260 xc(i)=(xc(i)+max_slope(i))/xl0(i)
261
262
263! sinon derivée au point courrant
264 ENDDO
265C
266 1000 FORMAT(1x,'-- RUPTURE OF SPRING ELEMENT NUMBER ',i10)
267 1100 FORMAT(1x,'-- RUPTURE OF SPRING ELEMENT :',i10,' AT TIME :',g11.4)
268C
269 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21