OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7ass3.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| i7ass33 ../engine/source/interfaces/int07/i7ass3.F
25!||--- called by ------------------------------------------------------
26!|| i7mainf ../engine/source/interfaces/int07/i7mainf.F
27!||--- calls -----------------------------------------------------
28!|| i7ass0 ../engine/source/interfaces/int07/i7ass3.F
29!|| i7ass05 ../engine/source/interfaces/int07/i7ass3.F
30!|| i7ass2 ../engine/source/interfaces/int07/i7ass3.F
31!|| i7ass25 ../engine/source/interfaces/int07/i7ass3.F
32!|| i7ass3 ../engine/source/interfaces/int07/i7ass3.F
33!|| i7ass35 ../engine/source/interfaces/int07/i7ass3.F
34!|| i7assigeo0 ../engine/source/interfaces/int07/i7ass3.F
35!|| i7sms2 ../engine/source/interfaces/int07/i7sms2.F
36!||--- uses -----------------------------------------------------
37!|| h3d_mod ../engine/share/modules/h3d_mod.F
38!|| tri7box ../engine/share/modules/tri7box.F
39!||====================================================================
40 SUBROUTINE i7ass33(JLT ,A ,NOINT ,ITAB ,STIFN ,
41 2 STIF ,FSKYI ,ISKY ,FCONT ,IX1 ,
42 3 IX2 ,IX3 ,IX4 ,NSVG ,NELTST ,
43 4 ITYPTST ,DT2T ,NISKYFI ,ISECIN ,NSTRF ,
44 5 SECFCUM ,VISCN ,NIN ,FXI ,FYI ,
45 6 FZI ,FX1 ,FY1 ,FZ1 ,FX2 ,
46 7 FY2 ,FZ2 ,FX3 ,FY3 ,FZ3 ,
47 8 FX4 ,FY4 ,FZ4 ,H1 ,H2 ,
48 9 H3 ,H4 ,KS ,KT ,K1 ,
49 A K2 ,K3 ,K4 ,CS ,CF ,
50 B C1 ,C2 ,C3 ,C4 ,C ,
51 C INTTH ,PHI ,PHI1 ,PHI2 ,PHI3 ,
52 D PHI4 ,FTHE ,FTHESKYI ,MSKYI_SMS ,ISKYI_SMS ,
53 E NSMS ,DTMINI ,JTASK ,
54 F CONDN ,CONDINT ,CONDNSKYI,IXIG3D ,KXIG3D ,
55 J WIGE ,KNOT ,IGEO ,NIGE ,RIGE ,
56 K X ,H3D_DATA ,KNOTLOCPC ,KNOTLOCEL,IFORM ,
57 L NODADT_THERM)
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE tri7box
62 USE h3d_mod
63C-----------------------------------------------
64C I m p l i c i t T y p e s
65C-----------------------------------------------
66#include "implicit_f.inc"
67#include "comlock.inc"
68C-----------------------------------------------
69C G l o b a l P a r a m e t e r s
70C-----------------------------------------------
71#include "mvsiz_p.inc"
72C-----------------------------------------------
73C C o m m o n B l o c k s
74C-----------------------------------------------
75#include "com01_c.inc"
76#include "com04_c.inc"
77#include "scr14_c.inc"
78#include "scr16_c.inc"
79#include "scr18_c.inc"
80#include "sms_c.inc"
81#include "parit_c.inc"
82#include "param_c.inc"
83#include "impl1_c.inc"
84C-----------------------------------------------
85C D u m m y A r g u m e n t s
86C-----------------------------------------------
87 INTEGER NELTST,ITYPTST,JLT,NIN,NOINT,ISECIN,JTASK,NISKYFI,INTTH,IFORM
88
89 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
90 . NSVG(MVSIZ),ITAB(*), ISKY(*), NSTRF(*),
91 . NISUB,ISKYI_SMS(*), NSMS(*),
92 . KXIG3D(NIXIG3D,*),IXIG3D(*),IGEO(NPROPGI,*),NIGE(*)
93 INTEGER ,INTENT(IN) :: NODADT_THERM
94 my_real
95 . X(3,*), A(3,*), FCONT(3,*),DT2T,DTMINI,
96 . STIFN(*), FSKYI(LSKYI,NFSKYI),
97 . MSKYI_SMS(*)
98 my_real
99 . STIF(MVSIZ),SECFCUM(7,NUMNOD,NSECT),
100 . VISCN(*),PHI(MVSIZ), FTHE(*),FTHESKYI(LSKYI),
101 . PHI1(MVSIZ),PHI2(MVSIZ),PHI3(MVSIZ),PHI4(MVSIZ) ,
102 . CONDINT(MVSIZ),CONDN(*),CONDNSKYI(LSKYI)
103 my_real
104 . fxi(mvsiz), fyi(mvsiz), fzi(mvsiz),
105 . fx1(mvsiz), fx2(mvsiz), fx3(mvsiz), fx4(mvsiz),
106 . fy1(mvsiz), fy2(mvsiz), fy3(mvsiz), fy4(mvsiz),
107 . fz1(mvsiz), fz2(mvsiz), fz3(mvsiz), fz4(mvsiz),
108 . h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz),
109 . ks(mvsiz),k1(mvsiz),k2(mvsiz),k3(mvsiz),k4(mvsiz),
110 . cs(mvsiz),c1(mvsiz),c2(mvsiz),c3(mvsiz),c4(mvsiz),
111 . kt(mvsiz),c(mvsiz),cf(mvsiz)
112 my_real
113 . wige(*),knot(*),rige(3,*),knotlocpc(*),knotlocel(*)
114 TYPE(h3d_database) :: H3D_DATA
115C-----------------------------------------------
116C L o c a l V a r i a b l e s
117C-----------------------------------------------
118 INTEGER I,K,JG,K0,NBINTER,K1S,J,IG,IBCM,IBCS,TAGIGEO
119 my_real
120 . dti
121C-------------------------------------------------------------------------------
122C
123 IF(idtmins==2.OR.idtmins_int/=0)THEN
124 dti=dt2t
125 CALL i7sms2(jlt ,ix1 ,ix2 ,ix3 ,ix4 ,
126 2 nsvg ,h1 ,h2 ,h3 ,h4 ,stif ,
127 3 nin ,noint ,mskyi_sms, iskyi_sms,nsms ,
128 4 kt ,c ,cf ,dtmini,dti )
129 IF(dti<dt2t)THEN
130 dt2t = dti
131 neltst = noint
132 ityptst = 10
133 ENDIF
134 ENDIF
135C
136 IF(idtmins_int/=0)THEN
137 stif(1:jlt)=zero
138 END IF
139C
140C-----Isogeometric elements
141 tagigeo=0
142c
143 IF(iparit==3)THEN
144 IF(kdtint==0)THEN
145 CALL i7ass3(jlt ,ix1 ,ix2 ,ix3 ,ix4 ,
146 2 nsvg ,h1 ,h2 ,h3 ,h4 ,stif ,
147 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,fz2 ,
148 4 fx3 ,fy3 ,fz3 ,fx4 ,fy4 ,fz4 ,
149 5 fxi ,fyi ,fzi ,a ,stifn)
150 ELSE
151 CALL i7ass35(jlt ,ix1 ,ix2 ,ix3 ,ix4 ,
152 2 nsvg ,h1 ,h2 ,h3 ,h4 ,stif ,
153 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,fz2 ,
154 4 fx3 ,fy3 ,fz3 ,fx4 ,fy4 ,fz4 ,
155 5 fxi ,fyi ,fzi ,a ,stifn,viscn,
156 6 ks ,k1 ,k2 ,k3 ,k4 ,cs ,
157 7 c1 ,c2 ,c3 ,c4 )
158 ENDIF
159 ELSEIF(iparit==0)THEN
160 IF(kdtint==0)THEN
161 DO i=1,jlt
162 IF(ix1(i)>=numnod.AND.ix2(i)>=numnod.AND.
163 . ix3(i)>=numnod.AND.ix4(i)>=numnod)THEN
164 tagigeo=tagigeo+1
165 ENDIF
166 ENDDO
167 IF(tagigeo==0) THEN
168 CALL i7ass0(jlt ,ix1 ,ix2 ,ix3 ,ix4 ,
169 2 nsvg ,h1 ,h2 ,h3 ,h4 ,stif ,
170 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,fz2 ,
171 4 fx3 ,fy3 ,fz3 ,fx4 ,fy4 ,fz4 ,
172 5 fxi ,fyi ,fzi ,a ,stifn ,nin ,
173 6 intth ,phi ,fthe ,phi1 , phi2 ,phi3 ,
174 7 phi4 ,condn,condint,jtask,iform,nodadt_therm)
175 ELSE
176 CALL i7assigeo0(jlt ,ix1 ,ix2 ,ix3 ,ix4 ,
177 2 nsvg ,h1 ,h2 ,h3 ,h4 ,stif ,
178 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,fz2 ,
179 4 fx3 ,fy3 ,fz3 ,fx4 ,fy4 ,fz4 ,
180 5 fxi ,fyi ,fzi ,a ,stifn ,ixig3d,
181 6 kxig3d,x ,wige ,knot ,igeo ,nige,
182 7 rige ,fcont,h3d_data,knotlocpc,knotlocel)
183 ENDIF
184 ELSE
185C
186 CALL i7ass05(jlt ,ix1 ,ix2 ,ix3 ,ix4 ,
187 2 nsvg ,h1 ,h2 ,h3 ,h4 ,
188 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,fz2 ,
189 4 fx3 ,fy3 ,fz3 ,fx4 ,fy4 ,fz4 ,
190 5 fxi ,fyi ,fzi ,a ,stifn ,viscn ,
191 6 ks ,k1 ,k2 ,k3 ,k4 ,cs ,
192 7 c1 ,c2 ,c3 ,c4 ,nin ,intth ,
193 8 phi ,fthe ,phi1 , phi2 ,phi3 , phi4 ,
194 9 jtask,condn,condint,iform,nodadt_therm)
195 ENDIF
196C
197 ELSE
198 IF(kdtint==0)THEN
199 IF(tagigeo==0) THEN
200 CALL i7ass2(jlt ,ix1 ,ix2 ,ix3 ,ix4 ,
201 2 nsvg ,h1 ,h2 ,h3 ,h4 ,stif ,
202 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,fz2 ,
203 4 fx3 ,fy3 ,fz3 ,fx4 ,fy4 ,fz4 ,
204 5 fxi ,fyi ,fzi ,fskyi,isky ,niskyfi,
205 6 nin ,noint ,intth,phi ,ftheskyi ,phi1,
206 7 phi2 ,phi3 , phi4 ,condnskyi,condint,
207 a iform ,nodadt_therm)
208 ELSE
209c CALL I7ASSIGEO2(JLT ,IX1 ,IX2 ,IX3 ,IX4 ,
210c 2 NSVG ,H1 ,H2 ,H3 ,H4 ,STIF ,
211c 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,FZ2 ,
212c 4 FX3 ,FY3 ,FZ3 ,FX4 ,FY4 ,FZ4 ,
213c 5 FXI ,FYI ,FZI ,FSKYI,ISKY ,NISKYFI,
214c 6 NIN ,NOINT ,INTTH,PHI ,FTHESKYI ,PHI1,
215c 7 PHI2 ,PHI3 , PHI4 ,CONDNSKYI,CONDINT,IXIG3D,
216c 6 KXIG3D,X ,WIGE ,KNOT ,IGEO ,NIGE,
217c 7 RIGE ,FCONT,H3D_DATA,KNOTLOCPC,KNOTLOCEL)
218 ENDIF
219 ELSE
220 CALL i7ass25(jlt ,ix1 ,ix2 ,ix3 ,ix4 ,
221 2 nsvg ,h1 ,h2 ,h3 ,h4 ,
222 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,fz2 ,
223 4 fx3 ,fy3 ,fz3 ,fx4 ,fy4 ,fz4 ,
224 5 fxi ,fyi ,fzi ,fskyi,niskyfi,nin ,
225 6 ks ,k1 ,k2 ,k3 ,k4 ,cs ,
226 7 c1 ,c2 ,c3 ,c4 ,isky ,noint ,
227 8 intth ,phi ,ftheskyi ,phi1 ,phi2 , phi3,
228 9 phi4 ,condnskyi,condint,iform,nodadt_therm)
229 ENDIF
230 ENDIF
231C
232 IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0)THEN
233 IF (inconv==1) THEN
234#include "lockon.inc"
235 DO i=1,jlt
236 fcont(1,ix1(i)) =fcont(1,ix1(i)) + fx1(i)
237 fcont(2,ix1(i)) =fcont(2,ix1(i)) + fy1(i)
238 fcont(3,ix1(i)) =fcont(3,ix1(i)) + fz1(i)
239 fcont(1,ix2(i)) =fcont(1,ix2(i)) + fx2(i)
240 fcont(2,ix2(i)) =fcont(2,ix2(i)) + fy2(i)
241 fcont(3,ix2(i)) =fcont(3,ix2(i)) + fz2(i)
242 fcont(1,ix3(i)) =fcont(1,ix3(i)) + fx3(i)
243 fcont(2,ix3(i)) =fcont(2,ix3(i)) + fy3(i)
244 fcont(3,ix3(i)) =fcont(3,ix3(i)) + fz3(i)
245 fcont(1,ix4(i)) =fcont(1,ix4(i)) + fx4(i)
246 fcont(2,ix4(i)) =fcont(2,ix4(i)) + fy4(i)
247 fcont(3,ix4(i)) =fcont(3,ix4(i)) + fz4(i)
248 jg = nsvg(i)
249 IF(jg>0) THEN
250C en SPMD : traitement a refaire apres reception noeud remote si JG < 0
251 fcont(1,jg)=fcont(1,jg)- fxi(i)
252 fcont(2,jg)=fcont(2,jg)- fyi(i)
253 fcont(3,jg)=fcont(3,jg)- fzi(i)
254 ENDIF
255 ENDDO
256#include "lockoff.inc"
257 END IF !(INCONV==1) THEN
258 ENDIF
259C-----------------------------------------------------
260 IF(isecin>0.AND.inconv==1)THEN
261 k0=nstrf(25)
262 IF(nstrf(1)+nstrf(2)/=0)THEN
263 DO i=1,nsect
264 nbinter=nstrf(k0+14)
265 k1s=k0+30
266 DO j=1,nbinter
267 IF(nstrf(k1s)==noint)THEN
268 IF(isecut/=0)THEN
269#include "lockon.inc"
270 DO k=1,jlt
271C attention aux signes pour le cumul des efforts
272C a rendre conforme avec CFORC3
273 IF(secfcum(4,ix1(k),i)==1.)THEN
274 secfcum(1,ix1(k),i)=secfcum(1,ix1(k),i)-fx1(k)
275 secfcum(2,ix1(k),i)=secfcum(2,ix1(k),i)-fy1(k)
276 secfcum(3,ix1(k),i)=secfcum(3,ix1(k),i)-fz1(k)
277 ENDIF
278 IF(secfcum(4,ix2(k),i)==1.)THEN
279 secfcum(1,ix2(k),i)=secfcum(1,ix2(k),i)-fx2(k)
280 secfcum(2,ix2(k),i)=secfcum(2,ix2(k),i)-fy2(k)
281 secfcum(3,ix2(k),i)=secfcum(3,ix2(k),i)-fz2(k)
282 ENDIF
283 IF(secfcum(4,ix3(k),i)==1.)THEN
284 secfcum(1,ix3(k),i)=secfcum(1,ix3(k),i)-fx3(k)
285 secfcum(2,ix3(k),i)=secfcum(2,ix3(k),i)-fy3(k)
286 secfcum(3,ix3(k),i)=secfcum(3,ix3(k),i)-fz3(k)
287 ENDIF
288 IF(secfcum(4,ix4(k),i)==1.)THEN
289 secfcum(1,ix4(k),i)=secfcum(1,ix4(k),i)-fx4(k)
290 secfcum(2,ix4(k),i)=secfcum(2,ix4(k),i)-fy4(k)
291 secfcum(3,ix4(k),i)=secfcum(3,ix4(k),i)-fz4(k)
292 ENDIF
293 jg = nsvg(k)
294 IF(jg>0) THEN
295C en SPMD : traitement a refaire apres reception noeud remote si JG < 0
296 IF(secfcum(4,jg,i)==1.)THEN
297 secfcum(1,jg,i)=secfcum(1,jg,i)+fxi(k)
298 secfcum(2,jg,i)=secfcum(2,jg,i)+fyi(k)
299 secfcum(3,jg,i)=secfcum(3,jg,i)+fzi(k)
300 ENDIF
301 ENDIF
302 ENDDO
303#include "lockoff.inc"
304 ENDIF
305C +fsav(section)
306 ENDIF
307 k1s=k1s+1
308 ENDDO
309 k0=nstrf(k0+24)
310 ENDDO
311 ENDIF
312 ENDIF
313C-----------------------------------------------------
314 RETURN
315 END
316!||====================================================================
317!|| i7ass3 ../engine/source/interfaces/int07/i7ass3.F
318!||--- called by ------------------------------------------------------
319!|| i18for3 ../engine/source/interfaces/int18/i18for3.F
320!|| i20for3 ../engine/source/interfaces/int20/i20for3.F
321!|| i22for3 ../engine/source/interfaces/int22/i22for3.F
322!|| i23for3 ../engine/source/interfaces/int23/i23for3.F
323!|| i7ass33 ../engine/source/interfaces/int07/i7ass3.F
324!||--- calls -----------------------------------------------------
325!|| double_flot_ieee ../engine/source/system/parit.F
326!||====================================================================
327 SUBROUTINE i7ass3(JLT ,IX1 ,IX2 ,IX3 ,IX4 ,
328 2 NSVG ,H1 ,H2 ,H3 ,H4 ,STIF ,
329 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,FZ2 ,
330 4 FX3 ,FY3 ,FZ3 ,FX4 ,FY4 ,FZ4 ,
331 5 FXI ,FYI ,FZI ,I8A ,I8STIFN )
332C-----------------------------------------------
333C I m p l i c i t T y p e s
334C-----------------------------------------------
335#include "implicit_f.inc"
336C-----------------------------------------------
337C G l o b a l P a r a m e t e r s
338C-----------------------------------------------
339#include "mvsiz_p.inc"
340C-----------------------------------------------
341C D u m m y A r g u m e n t s
342C-----------------------------------------------
343 INTEGER JLT
344 INTEGER IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),NSVG(MVSIZ)
345 integer*8 I8A(3,3,*), I8STIFN(3,*)
346 my_real
347 . H1(MVSIZ),H2(MVSIZ),H3(MVSIZ),H4(MVSIZ),STIF(MVSIZ),
348 . fx1(mvsiz),fy1(mvsiz),fz1(mvsiz),
349 . fx2(mvsiz),fy2(mvsiz),fz2(mvsiz),
350 . fx3(mvsiz),fy3(mvsiz),fz3(mvsiz),
351 . fx4(mvsiz),fy4(mvsiz),fz4(mvsiz),
352 . fxi(mvsiz),fyi(mvsiz),fzi(mvsiz)
353C-----------------------------------------------
354C L o c a l V a r i a b l e s
355C-----------------------------------------------
356 integer*8
357 . i8stif(3,mvsiz),i8fx(3,mvsiz),i8fy(3,mvsiz),i8fz(3,mvsiz)
358 INTEGER I,J1
359 my_real
360 . STIF1(MVSIZ),STIF2(MVSIZ),STIF3(MVSIZ),STIF4(MVSIZ)
361C
362 DO I=1 ,jlt
363 stif1(i) = stif(i)*abs(h1(i))
364 stif2(i) = stif(i)*abs(h2(i))
365 stif3(i) = stif(i)*abs(h3(i))
366 stif4(i) = stif(i)*abs(h4(i))
367 ENDDO
368C
369 CALL double_flot_ieee(1,jlt,fx1,fx1,i8fx)
370 CALL double_flot_ieee(1,jlt,fy1,fy1,i8fy)
371 CALL double_flot_ieee(1,jlt,fz1,fz1,i8fz)
372 CALL double_flot_ieee(1,jlt,stif1,stif1,i8stif)
373C
374 DO i=1 ,jlt
375 j1=ix1(i)
376 i8a(1,1,j1)=i8a(1,1,j1) + i8fx(1,i)
377 i8a(2,1,j1)=i8a(2,1,j1) + i8fx(2,i)
378 i8a(3,1,j1)=i8a(3,1,j1) + i8fx(3,i)
379C
380 i8a(1,2,j1)=i8a(1,2,j1) + i8fy(1,i)
381 i8a(2,2,j1)=i8a(2,2,j1) + i8fy(2,i)
382 i8a(3,2,j1)=i8a(3,2,j1) + i8fy(3,i)
383C
384 i8a(1,3,j1)=i8a(1,3,j1) + i8fz(1,i)
385 i8a(2,3,j1)=i8a(2,3,j1) + i8fz(2,i)
386 i8a(3,3,j1)=i8a(3,3,j1) + i8fz(3,i)
387C
388 i8stifn(1,j1) = i8stifn(1,j1) + i8stif(1,i)
389 i8stifn(2,j1) = i8stifn(2,j1) + i8stif(2,i)
390 i8stifn(3,j1) = i8stifn(3,j1) + i8stif(3,i)
391 ENDDO
392C
393 CALL double_flot_ieee(1,jlt,fx2,fx2,i8fx)
394 CALL double_flot_ieee(1,jlt,fy2,fy2,i8fy)
395 CALL double_flot_ieee(1,jlt,fz2,fz2,i8fz)
396 CALL double_flot_ieee(1,jlt,stif2,stif2,i8stif)
397C
398 DO i=1 ,jlt
399 j1=ix2(i)
400 i8a(1,1,j1)=i8a(1,1,j1) + i8fx(1,i)
401 i8a(2,1,j1)=i8a(2,1,j1) + i8fx(2,i)
402 i8a(3,1,j1)=i8a(3,1,j1) + i8fx(3,i)
403C
404 i8a(1,2,j1)=i8a(1,2,j1) + i8fy(1,i)
405 i8a(2,2,j1)=i8a(2,2,j1) + i8fy(2,i)
406 i8a(3,2,j1)=i8a(3,2,j1) + i8fy(3,i)
407C
408 i8a(1,3,j1)=i8a(1,3,j1) + i8fz(1,i)
409 i8a(2,3,j1)=i8a(2,3,j1) + i8fz(2,i)
410 i8a(3,3,j1)=i8a(3,3,j1) + i8fz(3,i)
411C
412 i8stifn(1,j1) = i8stifn(1,j1) + i8stif(1,i)
413 i8stifn(2,j1) = i8stifn(2,j1) + i8stif(2,i)
414 i8stifn(3,j1) = i8stifn(3,j1) + i8stif(3,i)
415 ENDDO
416C
417 CALL double_flot_ieee(1,jlt,fx3,fx3,i8fx)
418 CALL double_flot_ieee(1,jlt,fy3,fy3,i8fy)
419 CALL double_flot_ieee(1,jlt,fz3,fz3,i8fz)
420 CALL double_flot_ieee(1,jlt,stif3,stif3,i8stif)
421C
422 DO i=1 ,jlt
423 j1=ix3(i)
424 i8a(1,1,j1)=i8a(1,1,j1) + i8fx(1,i)
425 i8a(2,1,j1)=i8a(2,1,j1) + i8fx(2,i)
426 i8a(3,1,j1)=i8a(3,1,j1) + i8fx(3,i)
427C
428 i8a(1,2,j1)=i8a(1,2,j1) + i8fy(1,i)
429 i8a(2,2,j1)=i8a(2,2,j1) + i8fy(2,i)
430 i8a(3,2,j1)=i8a(3,2,j1) + i8fy(3,i)
431C
432 i8a(1,3,j1)=i8a(1,3,j1) + i8fz(1,i)
433 i8a(2,3,j1)=i8a(2,3,j1) + i8fz(2,i)
434 i8a(3,3,j1)=i8a(3,3,j1) + i8fz(3,i)
435C
436 i8stifn(1,j1) = i8stifn(1,j1) + i8stif(1,i)
437 i8stifn(2,j1) = i8stifn(2,j1) + i8stif(2,i)
438 i8stifn(3,j1) = i8stifn(3,j1) + i8stif(3,i)
439 ENDDO
440C
441 CALL double_flot_ieee(1,jlt,fx4,fx4,i8fx)
442 CALL double_flot_ieee(1,jlt,fy4,fy4,i8fy)
443 CALL double_flot_ieee(1,jlt,fz4,fz4,i8fz)
444 CALL double_flot_ieee(1,jlt,stif4,stif4,i8stif)
445C
446 DO i=1 ,jlt
447 j1=ix4(i)
448 i8a(1,1,j1)=i8a(1,1,j1) + i8fx(1,i)
449 i8a(2,1,j1)=i8a(2,1,j1) + i8fx(2,i)
450 i8a(3,1,j1)=i8a(3,1,j1) + i8fx(3,i)
451C
452 i8a(1,2,j1)=i8a(1,2,j1) + i8fy(1,i)
453 i8a(2,2,j1)=i8a(2,2,j1) + i8fy(2,i)
454 i8a(3,2,j1)=i8a(3,2,j1) + i8fy(3,i)
455C
456 i8a(1,3,j1)=i8a(1,3,j1) + i8fz(1,i)
457 i8a(2,3,j1)=i8a(2,3,j1) + i8fz(2,i)
458 i8a(3,3,j1)=i8a(3,3,j1) + i8fz(3,i)
459C
460 i8stifn(1,j1) = i8stifn(1,j1) + i8stif(1,i)
461 i8stifn(2,j1) = i8stifn(2,j1) + i8stif(2,i)
462 i8stifn(3,j1) = i8stifn(3,j1) + i8stif(3,i)
463 ENDDO
464C
465 CALL double_flot_ieee(1,jlt,fxi,fxi,i8fx)
466 CALL double_flot_ieee(1,jlt,fyi,fyi,i8fy)
467 CALL double_flot_ieee(1,jlt,fzi,fzi,i8fz)
468 CALL double_flot_ieee(1,jlt,stif,stif,i8stif)
469C
470 DO i=1 ,jlt
471 j1=nsvg(i)
472 i8a(1,1,j1)=i8a(1,1,j1) - i8fx(1,i)
473 i8a(2,1,j1)=i8a(2,1,j1) - i8fx(2,i)
474 i8a(3,1,j1)=i8a(3,1,j1) - i8fx(3,i)
475C
476 i8a(1,2,j1)=i8a(1,2,j1) - i8fy(1,i)
477 i8a(2,2,j1)=i8a(2,2,j1) - i8fy(2,i)
478 i8a(3,2,j1)=i8a(3,2,j1) - i8fy(3,i)
479C
480 i8a(1,3,j1)=i8a(1,3,j1) - i8fz(1,i)
481 i8a(2,3,j1)=i8a(2,3,j1) - i8fz(2,i)
482 i8a(3,3,j1)=i8a(3,3,j1) - i8fz(3,i)
483C
484 i8stifn(1,j1) = i8stifn(1,j1) + i8stif(1,i)
485 i8stifn(2,j1) = i8stifn(2,j1) + i8stif(2,i)
486 i8stifn(3,j1) = i8stifn(3,j1) + i8stif(3,i)
487 ENDDO
488C
489 RETURN
490 END
491!||====================================================================
492!|| i7ass35 ../engine/source/interfaces/int07/i7ass3.F
493!||--- called by ------------------------------------------------------
494!|| i20for3 ../engine/source/interfaces/int20/i20for3.F
495!|| i23for3 ../engine/source/interfaces/int23/i23for3.F
496!|| i7ass33 ../engine/source/interfaces/int07/i7ass3.f
497!||--- calls -----------------------------------------------------
498!|| double_flot_ieee ../engine/source/system/parit.f
499!||====================================================================
500 SUBROUTINE i7ass35(JLT ,IX1 ,IX2 ,IX3 ,IX4 ,
501 2 NSVG ,H1 ,H2 ,H3 ,H4 ,STIF ,
502 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,FZ2 ,
503 4 FX3 ,FY3 ,FZ3 ,FX4 ,FY4 ,FZ4 ,
504 5 FXI ,FYI ,FZI ,I8A ,I8STIFN ,I8VISCN,
505 6 KS ,K1 ,K2 ,K3 ,K4 ,CS ,
506 7 C1 ,C2 ,C3 ,C4 )
507C-----------------------------------------------
508C I m p l i c i t T y p e s
509C-----------------------------------------------
510#include "implicit_f.inc"
511C-----------------------------------------------
512C G l o b a l P a r a m e t e r s
513C-----------------------------------------------
514#include "mvsiz_p.inc"
515C-----------------------------------------------
516C D u m m y A r g u m e n t s
517C-----------------------------------------------
518 INTEGER JLT
519 INTEGER IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),NSVG(MVSIZ)
520 integer*8 I8A(3,3,*), I8STIFN(3,*), I8VISCN(3,*)
521 my_real
522 . H1(MVSIZ),H2(MVSIZ),H3(MVSIZ),H4(MVSIZ),STIF(MVSIZ),
523 . FX1(MVSIZ),FY1(MVSIZ),FZ1(MVSIZ),
524 . FX2(MVSIZ),FY2(MVSIZ),FZ2(MVSIZ),
525 . FX3(MVSIZ),FY3(MVSIZ),FZ3(MVSIZ),
526 . FX4(MVSIZ),FY4(MVSIZ),FZ4(MVSIZ),
527 . fxi(mvsiz),fyi(mvsiz),fzi(mvsiz),
528 . ks(mvsiz),k1(mvsiz),k2(mvsiz),k3(mvsiz),k4(mvsiz),
529 . cs(mvsiz),c1(mvsiz),c2(mvsiz),c3(mvsiz),c4(mvsiz)
530C-----------------------------------------------
531C L o c a l V a r i a b l e s
532C-----------------------------------------------
533 integer*8
534 . i8stif(3,mvsiz),i8fx(3,mvsiz),i8fy(3,mvsiz),i8fz(3,mvsiz),
535 . i8visc(3,mvsiz)
536 INTEGER I,J1
537 my_real
538 . STIF1(MVSIZ),STIF2(MVSIZ),STIF3(MVSIZ),STIF4(MVSIZ),
539 . VISC1(MVSIZ),VISC2(MVSIZ),VISC3(MVSIZ),VISC4(MVSIZ)
540C
541 DO I=1 ,jlt
542 stif1(i) = k1(i)
543 stif2(i) = k2(i)
544 stif3(i) = k3(i)
545 stif4(i) = k4(i)
546 visc1(i) = c1(i)
547 visc2(i) = c2(i)
548 visc3(i) = c3(i)
549 visc4(i) = c4(i)
550 ENDDO
551C
552 CALL double_flot_ieee(1,jlt,fx1,fx1,i8fx)
553 CALL double_flot_ieee(1,jlt,fy1,fy1,i8fy)
554 CALL double_flot_ieee(1,jlt,fz1,fz1,i8fz)
555 CALL double_flot_ieee(1,jlt,stif1,stif1,i8stif)
556 CALL double_flot_ieee(1,jlt,visc1,visc1,i8visc)
557C
558 DO i=1 ,jlt
559 j1=ix1(i)
560 i8a(1,1,j1)=i8a(1,1,j1) + i8fx(1,i)
561 i8a(2,1,j1)=i8a(2,1,j1) + i8fx(2,i)
562 i8a(3,1,j1)=i8a(3,1,j1) + i8fx(3,i)
563C
564 i8a(1,2,j1)=i8a(1,2,j1) + i8fy(1,i)
565 i8a(2,2,j1)=i8a(2,2,j1) + i8fy(2,i)
566 i8a(3,2,j1)=i8a(3,2,j1) + i8fy(3,i)
567C
568 i8a(1,3,j1)=i8a(1,3,j1) + i8fz(1,i)
569 i8a(2,3,j1)=i8a(2,3,j1) + i8fz(2,i)
570 i8a(3,3,j1)=i8a(3,3,j1) + i8fz(3,i)
571C
572 i8stifn(1,j1) = i8stifn(1,j1) + i8stif(1,i)
573 i8stifn(2,j1) = i8stifn(2,j1) + i8stif(2,i)
574 i8stifn(3,j1) = i8stifn(3,j1) + i8stif(3,i)
575C
576 i8viscn(1,j1) = i8viscn(1,j1) + i8visc(1,i)
577 i8viscn(2,j1) = i8viscn(2,j1) + i8visc(2,i)
578 i8viscn(3,j1) = i8viscn(3,j1) + i8visc(3,i)
579 ENDDO
580C
581 CALL double_flot_ieee(1,jlt,fx2,fx2,i8fx)
582 CALL double_flot_ieee(1,jlt,fy2,fy2,i8fy)
583 CALL double_flot_ieee(1,jlt,fz2,fz2,i8fz)
584 CALL double_flot_ieee(1,jlt,stif2,stif2,i8stif)
585 CALL double_flot_ieee(1,jlt,visc2,visc2,i8visc)
586C
587 DO i=1 ,jlt
588 j1=ix2(i)
589 i8a(1,1,j1)=i8a(1,1,j1) + i8fx(1,i)
590 i8a(2,1,j1)=i8a(2,1,j1) + i8fx(2,i)
591 i8a(3,1,j1)=i8a(3,1,j1) + i8fx(3,i)
592C
593 i8a(1,2,j1)=i8a(1,2,j1) + i8fy(1,i)
594 i8a(2,2,j1)=i8a(2,2,j1) + i8fy(2,i)
595 i8a(3,2,j1)=i8a(3,2,j1) + i8fy(3,i)
596C
597 i8a(1,3,j1)=i8a(1,3,j1) + i8fz(1,i)
598 i8a(2,3,j1)=i8a(2,3,j1) + i8fz(2,i)
599 i8a(3,3,j1)=i8a(3,3,j1) + i8fz(3,i)
600C
601 i8stifn(1,j1) = i8stifn(1,j1) + i8stif(1,i)
602 i8stifn(2,j1) = i8stifn(2,j1) + i8stif(2,i)
603 i8stifn(3,j1) = i8stifn(3,j1) + i8stif(3,i)
604C
605 i8viscn(1,j1) = i8viscn(1,j1) + i8visc(1,i)
606 i8viscn(2,j1) = i8viscn(2,j1) + i8visc(2,i)
607 i8viscn(3,j1) = i8viscn(3,j1) + i8visc(3,i)
608 ENDDO
609C
610 CALL double_flot_ieee(1,jlt,fx3,fx3,i8fx)
611 CALL double_flot_ieee(1,jlt,fy3,fy3,i8fy)
612 CALL double_flot_ieee(1,jlt,fz3,fz3,i8fz)
613 CALL double_flot_ieee(1,jlt,stif3,stif3,i8stif)
614 CALL double_flot_ieee(1,jlt,visc3,visc3,i8visc)
615C
616 DO i=1 ,jlt
617 j1=ix3(i)
618 i8a(1,1,j1)=i8a(1,1,j1) + i8fx(1,i)
619 i8a(2,1,j1)=i8a(2,1,j1) + i8fx(2,i)
620 i8a(3,1,j1)=i8a(3,1,j1) + i8fx(3,i)
621C
622 i8a(1,2,j1)=i8a(1,2,j1) + i8fy(1,i)
623 i8a(2,2,j1)=i8a(2,2,j1) + i8fy(2,i)
624 i8a(3,2,j1)=i8a(3,2,j1) + i8fy(3,i)
625C
626 i8a(1,3,j1)=i8a(1,3,j1) + i8fz(1,i)
627 i8a(2,3,j1)=i8a(2,3,j1) + i8fz(2,i)
628 i8a(3,3,j1)=i8a(3,3,j1) + i8fz(3,i)
629C
630 i8stifn(1,j1) = i8stifn(1,j1) + i8stif(1,i)
631 i8stifn(2,j1) = i8stifn(2,j1) + i8stif(2,i)
632 i8stifn(3,j1) = i8stifn(3,j1) + i8stif(3,i)
633C
634 i8viscn(1,j1) = i8viscn(1,j1) + i8visc(1,i)
635 i8viscn(2,j1) = i8viscn(2,j1) + i8visc(2,i)
636 i8viscn(3,j1) = i8viscn(3,j1) + i8visc(3,i)
637 ENDDO
638C
639 CALL double_flot_ieee(1,jlt,fx4,fx4,i8fx)
640 CALL double_flot_ieee(1,jlt,fy4,fy4,i8fy)
641 CALL double_flot_ieee(1,jlt,fz4,fz4,i8fz)
642 CALL double_flot_ieee(1,jlt,stif4,stif4,i8stif)
643 CALL double_flot_ieee(1,jlt,visc4,visc4,i8visc)
644C
645 DO i=1 ,jlt
646 j1=ix4(i)
647 i8a(1,1,j1)=i8a(1,1,j1) + i8fx(1,i)
648 i8a(2,1,j1)=i8a(2,1,j1) + i8fx(2,i)
649 i8a(3,1,j1)=i8a(3,1,j1) + i8fx(3,i)
650C
651 i8a(1,2,j1)=i8a(1,2,j1) + i8fy(1,i)
652 i8a(2,2,j1)=i8a(2,2,j1) + i8fy(2,i)
653 i8a(3,2,j1)=i8a(3,2,j1) + i8fy(3,i)
654C
655 i8a(1,3,j1)=i8a(1,3,j1) + i8fz(1,i)
656 i8a(2,3,j1)=i8a(2,3,j1) + i8fz(2,i)
657 i8a(3,3,j1)=i8a(3,3,j1) + i8fz(3,i)
658C
659 i8stifn(1,j1) = i8stifn(1,j1) + i8stif(1,i)
660 i8stifn(2,j1) = i8stifn(2,j1) + i8stif(2,i)
661 i8stifn(3,j1) = i8stifn(3,j1) + i8stif(3,i)
662C
663 i8viscn(1,j1) = i8viscn(1,j1) + i8visc(1,i)
664 i8viscn(2,j1) = i8viscn(2,j1) + i8visc(2,i)
665 i8viscn(3,j1) = i8viscn(3,j1) + i8visc(3,i)
666 ENDDO
667C
668 CALL double_flot_ieee(1,jlt,fxi,fxi,i8fx)
669 CALL double_flot_ieee(1,jlt,fyi,fyi,i8fy)
670 CALL double_flot_ieee(1,jlt,fzi,fzi,i8fz)
671 CALL double_flot_ieee(1,jlt,ks,ks,i8stif)
672 CALL double_flot_ieee(1,jlt,cs,cs,i8visc)
673C
674 DO i=1 ,jlt
675 j1=nsvg(i)
676 i8a(1,1,j1)=i8a(1,1,j1) - i8fx(1,i)
677 i8a(2,1,j1)=i8a(2,1,j1) - i8fx(2,i)
678 i8a(3,1,j1)=i8a(3,1,j1) - i8fx(3,i)
679C
680 i8a(1,2,j1)=i8a(1,2,j1) - i8fy(1,i)
681 i8a(2,2,j1)=i8a(2,2,j1) - i8fy(2,i)
682 i8a(3,2,j1)=i8a(3,2,j1) - i8fy(3,i)
683C
684 i8a(1,3,j1)=i8a(1,3,j1) - i8fz(1,i)
685 i8a(2,3,j1)=i8a(2,3,j1) - i8fz(2,i)
686 i8a(3,3,j1)=i8a(3,3,j1) - i8fz(3,i)
687C
688 i8stifn(1,j1) = i8stifn(1,j1) + i8stif(1,i)
689 i8stifn(2,j1) = i8stifn(2,j1) + i8stif(2,i)
690 i8stifn(3,j1) = i8stifn(3,j1) + i8stif(3,i)
691C
692 i8viscn(1,j1) = i8viscn(1,j1) + i8visc(1,i)
693 i8viscn(2,j1) = i8viscn(2,j1) + i8visc(2,i)
694 i8viscn(3,j1) = i8viscn(3,j1) + i8visc(3,i)
695 ENDDO
696C
697 RETURN
698 END
699C
700!||====================================================================
701!|| i7ass0 ../engine/source/interfaces/int07/i7ass3.F
702!||--- called by ------------------------------------------------------
703!|| i10for3 ../engine/source/interfaces/int10/i10for3.F
704!|| i18for3 ../engine/source/interfaces/int18/i18for3.F
705!|| i20for3 ../engine/source/interfaces/int20/i20for3.F
706!|| i23for3 ../engine/source/interfaces/int23/i23for3.F
707!|| i7ass33 ../engine/source/interfaces/int07/i7ass3.F
708!||--- uses -----------------------------------------------------
709!|| tri7box ../engine/share/modules/tri7box.F
710!||====================================================================
711 SUBROUTINE i7ass0(JLT ,IX1 ,IX2 ,IX3 ,IX4 ,
712 2 NSVG ,H1 ,H2 ,H3 ,H4 ,STIF ,
713 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,FZ2 ,
714 4 FX3 ,FY3 ,FZ3 ,FX4 ,FY4 ,FZ4 ,
715 5 FXI ,FYI ,FZI ,A ,STIFN ,NIN ,
716 6 INTTH ,PHI ,FTHE ,PHI1 , PHI2 ,PHI3 ,
717 7 PHI4 ,CONDN,CONDINT,JTASK,IFORM,NODADT_THERM)
718C-----------------------------------------------
719C M o d u l e s
720C-----------------------------------------------
721 USE tri7box
722C-----------------------------------------------
723C I m p l i c i t T y p e s
724C-----------------------------------------------
725#include "implicit_f.inc"
726C-----------------------------------------------
727C G l o b a l P a r a m e t e r s
728C-----------------------------------------------
729#include "mvsiz_p.inc"
730C-----------------------------------------------
731C C o m m o n B l o c k s
732C-----------------------------------------------
733#include "scr18_c.inc"
734C-----------------------------------------------
735C D u m m y A r g u m e n t s
736C-----------------------------------------------
737 INTEGER JLT, NIN,INTTH,JTASK,IFORM,
738 . IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),NSVG(MVSIZ)
739 INTEGER ,INTENT(IN) :: NODADT_THERM
740 my_real
741 . H1(MVSIZ),H2(MVSIZ),H3(MVSIZ),H4(MVSIZ),STIF(MVSIZ),
742 . FX1(MVSIZ),FY1(MVSIZ),FZ1(MVSIZ),
743 . FX2(MVSIZ),FY2(MVSIZ),FZ2(MVSIZ),
744 . fx3(mvsiz),fy3(mvsiz),fz3(mvsiz),
745 . fx4(mvsiz),fy4(mvsiz),fz4(mvsiz),
746 . fxi(mvsiz),fyi(mvsiz),fzi(mvsiz),
747 . a(3,*), stifn(*),phi(*), fthe(*),
748 . phi1(*), phi2(*), phi3(*), phi4(*),
749 . condn(*),condint(*)
750C-----------------------------------------------
751C L o c a l V a r i a b l e s
752C-----------------------------------------------
753 INTEGER I, J1, IG, ISHIFT, NODFI
754C
755 !---REACTION FORCE AGAINST LAGRANGIAN FACE
756 !
757 IF(intth == 0) THEN
758 DO i=1,jlt
759 j1=ix1(i)
760 a(1,j1)=a(1,j1)+fx1(i)
761 a(2,j1)=a(2,j1)+fy1(i)
762 a(3,j1)=a(3,j1)+fz1(i)
763 stifn(j1) = stifn(j1) + stif(i)*abs(h1(i))
764C
765 j1=ix2(i)
766 a(1,j1)=a(1,j1)+fx2(i)
767 a(2,j1)=a(2,j1)+fy2(i)
768 a(3,j1)=a(3,j1)+fz2(i)
769 stifn(j1) = stifn(j1) + stif(i)*abs(h2(i))
770C
771 j1=ix3(i)
772 a(1,j1)=a(1,j1)+fx3(i)
773 a(2,j1)=a(2,j1)+fy3(i)
774 a(3,j1)=a(3,j1)+fz3(i)
775 stifn(j1) = stifn(j1) + stif(i)*abs(h3(i))
776C
777 j1=ix4(i)
778 a(1,j1)=a(1,j1)+fx4(i)
779 a(2,j1)=a(2,j1)+fy4(i)
780 a(3,j1)=a(3,j1)+fz4(i)
781 stifn(j1) = stifn(j1) + stif(i)*abs(h4(i))
782 ENDDO
783 ELSE
784 IF(nodadt_therm == 1.AND.iform > 0 ) THEN
785 DO i=1,jlt
786 j1=ix1(i)
787 a(1,j1)=a(1,j1)+fx1(i)
788 a(2,j1)=a(2,j1)+fy1(i)
789 a(3,j1)=a(3,j1)+fz1(i)
790 stifn(j1) = stifn(j1) + stif(i)*abs(h1(i))
791 fthe(j1) = fthe(j1) + phi1(i)
792 condn(j1) = condn(j1) + condint(i)*abs(h1(i))
793C
794 j1=ix2(i)
795 a(1,j1)=a(1,j1)+fx2(i)
796 a(2,j1)=a(2,j1)+fy2(i)
797 a(3,j1)=a(3,j1)+fz2(i)
798 stifn(j1) = stifn(j1) + stif(i)*abs(h2(i))
799 fthe(j1) = fthe(j1) + phi2(i)
800 condn(j1) = condn(j1) + condint(i)*abs(h2(i))
801C
802 j1=ix3(i)
803 a(1,j1)=a(1,j1)+fx3(i)
804 a(2,j1)=a(2,j1)+fy3(i)
805 a(3,j1)=a(3,j1)+fz3(i)
806 stifn(j1) = stifn(j1) + stif(i)*abs(h3(i))
807 fthe(j1) = fthe(j1) + phi3(i)
808 condn(j1) = condn(j1) + condint(i)*abs(h3(i))
809C
810 j1=ix4(i)
811 a(1,j1)=a(1,j1)+fx4(i)
812 a(2,j1)=a(2,j1)+fy4(i)
813 a(3,j1)=a(3,j1)+fz4(i)
814 stifn(j1) = stifn(j1) + stif(i)*abs(h4(i))
815 fthe(j1) = fthe(j1) + phi4(i)
816 condn(j1) = condn(j1) + condint(i)*abs(h4(i))
817 ENDDO
818 ELSE
819 DO i=1,jlt
820 j1=ix1(i)
821 a(1,j1)=a(1,j1)+fx1(i)
822 a(2,j1)=a(2,j1)+fy1(i)
823 a(3,j1)=a(3,j1)+fz1(i)
824 stifn(j1) = stifn(j1) + stif(i)*abs(h1(i))
825 fthe(j1) = fthe(j1) + phi1(i)
826C
827 j1=ix2(i)
828 a(1,j1)=a(1,j1)+fx2(i)
829 a(2,j1)=a(2,j1)+fy2(i)
830 a(3,j1)=a(3,j1)+fz2(i)
831 stifn(j1) = stifn(j1) + stif(i)*abs(h2(i))
832 fthe(j1) = fthe(j1) + phi2(i)
833C
834 j1=ix3(i)
835 a(1,j1)=a(1,j1)+fx3(i)
836 a(2,j1)=a(2,j1)+fy3(i)
837 a(3,j1)=a(3,j1)+fz3(i)
838 stifn(j1) = stifn(j1) + stif(i)*abs(h3(i))
839 fthe(j1) = fthe(j1) + phi3(i)
840C
841 j1=ix4(i)
842 a(1,j1)=a(1,j1)+fx4(i)
843 a(2,j1)=a(2,j1)+fy4(i)
844 a(3,j1)=a(3,j1)+fz4(i)
845 stifn(j1) = stifn(j1) + stif(i)*abs(h4(i))
846 fthe(j1) = fthe(j1) + phi4(i)
847 ENDDO
848 ENDIF
849 ENDIF
850C
851 !---FLUID REACTION FORCE
852 !
853 nodfi = nlskyfi(nin)
854 ishift = nodfi*(jtask-1)
855 IF(intth == 0 ) THEN
856 DO i=1,jlt
857 ig=nsvg(i)
858 IF(ig>0)THEN
859 a(1,ig)=a(1,ig)-fxi(i)
860 a(2,ig)=a(2,ig)-fyi(i)
861 a(3,ig)=a(3,ig)-fzi(i)
862 stifn(ig) = stifn(ig) + stif(i)
863 ELSE
864 ig = -ig
865 afi(nin)%P(1,ig+ishift)=afi(nin)%P(1,ig+ishift)-fxi(i)
866 afi(nin)%P(2,ig+ishift)=afi(nin)%P(2,ig+ishift)-fyi(i)
867 afi(nin)%P(3,ig+ishift)=afi(nin)%P(3,ig+ishift)-fzi(i)
868 stnfi(nin)%P(ig+ishift)=stnfi(nin)%P(ig+ishift)+stif(i)
869 ENDIF
870 ENDDO
871C
872 ELSE
873 IF(nodadt_therm == 1 ) THEN
874 DO i=1,jlt
875 ig=nsvg(i)
876 IF(ig>0)THEN
877 a(1,ig)=a(1,ig)-fxi(i)
878 a(2,ig)=a(2,ig)-fyi(i)
879 a(3,ig)=a(3,ig)-fzi(i)
880 stifn(ig) = stifn(ig) + stif(i)
881 fthe(ig)=fthe(ig) + phi(i)
882 condn(ig) = condn(ig) + condint(i)
883 ELSE
884 ig = -ig
885 afi(nin)%P(1,ig+ishift)=afi(nin)%P(1,ig+ishift)-fxi(i)
886 afi(nin)%P(2,ig+ishift)=afi(nin)%P(2,ig+ishift)-fyi(i)
887 afi(nin)%P(3,ig+ishift)=afi(nin)%P(3,ig+ishift)-fzi(i)
888 stnfi(nin)%P(ig+ishift)=stnfi(nin)%P(ig+ishift) + stif(i)
889 fthefi(nin)%P(ig+ishift)= fthefi(nin)%P(ig+ishift) + phi(i)
890 condnfi(nin)%P(ig+ishift)=condnfi(nin)%P(ig+ishift) + condint(i)
891 ENDIF
892 ENDDO
893 ELSE
894 DO i=1,jlt
895 ig=nsvg(i)
896 IF(ig>0)THEN
897 a(1,ig)=a(1,ig)-fxi(i)
898 a(2,ig)=a(2,ig)-fyi(i)
899 a(3,ig)=a(3,ig)-fzi(i)
900 stifn(ig) = stifn(ig) + stif(i)
901 fthe(ig)=fthe(ig) + phi(i)
902 ELSE
903 ig = -ig
904 afi(nin)%P(1,ig+ishift)=afi(nin)%P(1,ig+ishift)-fxi(i)
905 afi(nin)%P(2,ig+ishift)=afi(nin)%P(2,ig+ishift)-fyi(i)
906 afi(nin)%P(3,ig+ishift)=afi(nin)%P(3,ig+ishift)-fzi(i)
907 stnfi(nin)%P(ig+ishift)=stnfi(nin)%P(ig+ishift) + stif(i)
908 fthefi(nin)%P(ig+ishift)= fthefi(nin)%P(ig+ishift) + phi(i)
909 ENDIF
910 ENDDO
911 ENDIF
912 ENDIF
913C
914 RETURN
915 END
916C
917!||====================================================================
918!|| i7ass05 ../engine/source/interfaces/int07/i7ass3.F
919!||--- called by ------------------------------------------------------
920!|| i10for3 ../engine/source/interfaces/int10/i10for3.F
921!|| i20for3 ../engine/source/interfaces/int20/i20for3.F
922!|| i23for3 ../engine/source/interfaces/int23/i23for3.F
923!|| i7ass33 ../engine/source/interfaces/int07/i7ass3.F
924!||--- uses -----------------------------------------------------
925!|| tri7box ../engine/share/modules/tri7box.F
926!||====================================================================
927 SUBROUTINE i7ass05(JLT ,IX1 ,IX2 ,IX3 ,IX4 ,
928 2 NSVG ,H1 ,H2 ,H3 ,H4 ,
929 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,FZ2 ,
930 4 FX3 ,FY3 ,FZ3 ,FX4 ,FY4 ,FZ4 ,
931 5 FXI ,FYI ,FZI ,A ,STIFN ,VISCN,
932 6 KS ,K1 ,K2 ,K3 ,K4 ,CS ,
933 7 C1 ,C2 ,C3 ,C4 ,NIN ,INTTH ,
934 8 PHI ,FTHE ,PHI1 , PHI2 ,PHI3 , PHI4 ,
935 9 JTASK ,CONDN,CONDINT,IFORM,NODADT_THERM)
936C-----------------------------------------------
937C M o d u l e s
938C-----------------------------------------------
939 USE tri7box
940C-----------------------------------------------
941C I m p l i c i t T y p e s
942C-----------------------------------------------
943#include "implicit_f.inc"
944C-----------------------------------------------
945C G l o b a l P a r a m e t e r s
946C-----------------------------------------------
947#include "mvsiz_p.inc"
948C-----------------------------------------------
949C C o m m o n B l o c k s
950C-----------------------------------------------
951#include "scr18_c.inc"
952C-----------------------------------------------
953C D u m m y A r g u m e n t s
954C-----------------------------------------------
955 INTEGER JLT, NIN,INTTH ,JTASK,IFORM,
956 . ix1(mvsiz),ix2(mvsiz),ix3(mvsiz),ix4(mvsiz),nsvg(mvsiz)
957 INTEGER ,INTENT(IN) :: NODADT_THERM
958 my_real
959 . H1(MVSIZ),H2(MVSIZ),H3(MVSIZ),H4(MVSIZ),
960 . FX1(MVSIZ),FY1(MVSIZ),FZ1(MVSIZ),
961 . FX2(MVSIZ),FY2(MVSIZ),FZ2(MVSIZ),
962 . FX3(MVSIZ),FY3(MVSIZ),FZ3(MVSIZ),
963 . FX4(MVSIZ),FY4(MVSIZ),FZ4(MVSIZ),
964 . FXI(MVSIZ),FYI(MVSIZ),FZI(MVSIZ),
965 . KS(MVSIZ),K1(MVSIZ),K2(MVSIZ),K3(MVSIZ),K4(MVSIZ),
966 . CS(MVSIZ),C1(MVSIZ),C2(MVSIZ),C3(MVSIZ),C4(MVSIZ),
967 . A(3,*), STIFN(*), VISCN(*),PHI(*),FTHE(*),
968 , phi1(*) , phi2(*) ,phi3(*) , phi4(*),condint(*),condn(*)
969C-----------------------------------------------
970C L o c a l V a r i a b l e s
971C-----------------------------------------------
972 INTEGER I, J1, IG,NODFI,ISHIFT
973C
974 IF(INTTH == 0) then
975 DO i=1,jlt
976 j1=ix1(i)
977 a(1,j1)=a(1,j1)+fx1(i)
978 a(2,j1)=a(2,j1)+fy1(i)
979 a(3,j1)=a(3,j1)+fz1(i)
980 stifn(j1)= stifn(j1)+k1(i)
981 viscn(j1)=viscn(j1)+c1(i)
982C
983 j1=ix2(i)
984 a(1,j1)=a(1,j1)+fx2(i)
985 a(2,j1)=a(2,j1)+fy2(i)
986 a(3,j1)=a(3,j1)+fz2(i)
987 stifn(j1)=stifn(j1)+k2(i)
988 viscn(j1)=viscn(j1)+c2(i)
989C
990 j1=ix3(i)
991 a(1,j1)=a(1,j1)+fx3(i)
992 a(2,j1)=a(2,j1)+fy3(i)
993 a(3,j1)=a(3,j1)+fz3(i)
994 stifn(j1)=stifn(j1)+k3(i)
995 viscn(j1)=viscn(j1)+c3(i)
996C
997 j1=ix4(i)
998 a(1,j1)=a(1,j1)+fx4(i)
999 a(2,j1)=a(2,j1)+fy4(i)
1000 a(3,j1)=a(3,j1)+fz4(i)
1001 stifn(j1)=stifn(j1)+k4(i)
1002 viscn(j1)=viscn(j1)+c4(i)
1003 ENDDO
1004 ELSE
1005 IF(nodadt_therm == 1 .AND.iform > 0) THEN
1006 DO i=1,jlt
1007 j1=ix1(i)
1008 a(1,j1)=a(1,j1)+fx1(i)
1009 a(2,j1)=a(2,j1)+fy1(i)
1010 a(3,j1)=a(3,j1)+fz1(i)
1011 stifn(j1)= stifn(j1)+k1(i)
1012 viscn(j1)=viscn(j1)+c1(i)
1013 fthe(j1)= fthe(j1) + phi1(i)
1014 condn(j1)= condn(j1) + condint(i)*abs(h1(i))
1015C
1016 j1=ix2(i)
1017 a(1,j1)=a(1,j1)+fx2(i)
1018 a(2,j1)=a(2,j1)+fy2(i)
1019 a(3,j1)=a(3,j1)+fz2(i)
1020 stifn(j1)=stifn(j1)+k2(i)
1021 viscn(j1)=viscn(j1)+c2(i)
1022 fthe(j1)= fthe(j1) + phi2(i)
1023 condn(j1)= condn(j1) + condint(i)*abs(h2(i))
1024C
1025 j1=ix3(i)
1026 a(1,j1)=a(1,j1)+fx3(i)
1027 a(2,j1)=a(2,j1)+fy3(i)
1028 a(3,j1)=a(3,j1)+fz3(i)
1029 stifn(j1)=stifn(j1)+k3(i)
1030 viscn(j1)=viscn(j1)+c3(i)
1031 fthe(j1)= fthe(j1) + phi3(i)
1032 condn(j1)= condn(j1) + condint(i)*abs(h3(i))
1033C
1034 j1=ix4(i)
1035 a(1,j1)=a(1,j1)+fx4(i)
1036 a(2,j1)=a(2,j1)+fy4(i)
1037 a(3,j1)=a(3,j1)+fz4(i)
1038 stifn(j1)=stifn(j1)+k4(i)
1039 viscn(j1)=viscn(j1)+c4(i)
1040 fthe(j1)= fthe(j1) + phi4(i)
1041 condn(j1)= condn(j1) + condint(i)*abs(h4(i))
1042 ENDDO
1043 ELSE
1044 DO i=1,jlt
1045 j1=ix1(i)
1046 a(1,j1)=a(1,j1)+fx1(i)
1047 a(2,j1)=a(2,j1)+fy1(i)
1048 a(3,j1)=a(3,j1)+fz1(i)
1049 stifn(j1)= stifn(j1)+k1(i)
1050 viscn(j1)=viscn(j1)+c1(i)
1051 fthe(j1)= fthe(j1) + phi1(i)
1052C
1053 j1=ix2(i)
1054 a(1,j1)=a(1,j1)+fx2(i)
1055 a(2,j1)=a(2,j1)+fy2(i)
1056 a(3,j1)=a(3,j1)+fz2(i)
1057 stifn(j1)=stifn(j1)+k2(i)
1058 viscn(j1)=viscn(j1)+c2(i)
1059 fthe(j1)= fthe(j1) + phi2(i)
1060C
1061 j1=ix3(i)
1062 a(1,j1)=a(1,j1)+fx3(i)
1063 a(2,j1)=a(2,j1)+fy3(i)
1064 a(3,j1)=a(3,j1)+fz3(i)
1065 stifn(j1)=stifn(j1)+k3(i)
1066 viscn(j1)=viscn(j1)+c3(i)
1067 fthe(j1)= fthe(j1) + phi3(i)
1068C
1069 j1=ix4(i)
1070 a(1,j1)=a(1,j1)+fx4(i)
1071 a(2,j1)=a(2,j1)+fy4(i)
1072 a(3,j1)=a(3,j1)+fz4(i)
1073 stifn(j1)=stifn(j1)+k4(i)
1074 viscn(j1)=viscn(j1)+c4(i)
1075 fthe(j1)= fthe(j1) + phi4(i)
1076 ENDDO
1077
1078 ENDIF
1079 ENDIF
1080C
1081 nodfi = nlskyfi(nin)
1082 ishift = nodfi*(jtask-1)
1083C
1084 IF(intth == 0) THEN
1085 DO i=1,jlt
1086 ig=nsvg(i)
1087 IF(ig>0)THEN
1088 a(1,ig)=a(1,ig)-fxi(i)
1089 a(2,ig)=a(2,ig)-fyi(i)
1090 a(3,ig)=a(3,ig)-fzi(i)
1091 stifn(ig)=stifn(ig)+ks(i)
1092 viscn(ig)=viscn(ig)+cs(i)
1093 ELSE
1094 ig = -ig
1095 afi(nin)%P(1,ig+ishift)=afi(nin)%P(1,ig+ishift)-fxi(i)
1096 afi(nin)%P(2,ig+ishift)=afi(nin)%P(2,ig+ishift)-fyi(i)
1097 afi(nin)%P(3,ig+ishift)=afi(nin)%P(3,ig+ishift)-fzi(i)
1098 stnfi(nin)%P(ig+ishift)=stnfi(nin)%P(ig+ishift)+ks(i)
1099 vscfi(nin)%P(ig+ishift)=vscfi(nin)%P(ig+ishift)+cs(i)
1100 ENDIF
1101 ENDDO
1102 ELSE
1103 DO i=1,jlt
1104 ig=nsvg(i)
1105 IF(ig>0)THEN
1106 a(1,ig)=a(1,ig)-fxi(i)
1107 a(2,ig)=a(2,ig)-fyi(i)
1108 a(3,ig)=a(3,ig)-fzi(i)
1109 stifn(ig)=stifn(ig)+ks(i)
1110 viscn(ig)=viscn(ig)+cs(i)
1111 fthe(ig)=fthe(ig) + phi(i)
1112 ELSE
1113 ig = -ig
1114 afi(nin)%P(1,ig+ishift)=afi(nin)%P(1,ig+ishift)-fxi(i)
1115 afi(nin)%P(2,ig+ishift)=afi(nin)%P(2,ig+ishift)-fyi(i)
1116 afi(nin)%P(3,ig+ishift)=afi(nin)%P(3,ig+ishift)-fzi(i)
1117 stnfi(nin)%P(ig+ishift)=stnfi(nin)%P(ig+ishift)+ks(i)
1118 vscfi(nin)%P(ig+ishift)=vscfi(nin)%P(ig+ishift)+cs(i)
1119 fthefi(nin)%P(ig+ishift)=fthefi(nin)%P(ig+ishift) + phi(i)
1120 ENDIF
1121 ENDDO
1122 ENDIF
1123C
1124 RETURN
1125 END
1126C
1127!||====================================================================
1128!|| i7ass2 ../engine/source/interfaces/int07/i7ass3.F
1129!||--- called by ------------------------------------------------------
1130!|| i10for3 ../engine/source/interfaces/int10/i10for3.f
1131!|| i18for3 ../engine/source/interfaces/int18/i18for3.F
1132!|| i20for3 ../engine/source/interfaces/int20/i20for3.F
1133!|| i23for3 ../engine/source/interfaces/int23/i23for3.F
1134!|| i7ass33 ../engine/source/interfaces/int07/i7ass3.F
1135!||--- calls -----------------------------------------------------
1136!|| ancmsg ../engine/source/output/message/message.f
1137!|| arret ../engine/source/system/arret.F
1138!||--- uses -----------------------------------------------------
1139!|| message_mod ../engine/share/message_module/message_mod.f
1140!|| tri7box ../engine/share/modules/tri7box.F
1141!||====================================================================
1142 SUBROUTINE i7ass2(JLT ,IX1 ,IX2 ,IX3 ,IX4 ,
1143 2 NSVG ,H1 ,H2 ,H3 ,H4 ,STIF ,
1144 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,FZ2 ,
1145 4 FX3 ,FY3 ,FZ3 ,FX4 ,FY4 ,FZ4 ,
1146 5 FXI ,FYI ,FZI ,FSKYI,ISKY ,NISKYFI,
1147 6 NIN ,NOINT ,INTTH,PHI ,FTHESKYI,PHI1,
1148 7 PHI2 ,PHI3 , PHI4 ,CONDNSKYI,CONDINT,
1149 A IFORM ,NODADT_THERM)
1150C-----------------------------------------------
1151C M o d u l e s
1152C-----------------------------------------------
1153 USE tri7box
1154 USE message_mod
1155C-----------------------------------------------
1156C I m p l i c i t T y p e s
1157C-----------------------------------------------
1158#include "implicit_f.inc"
1159#include "comlock.inc"
1160C-----------------------------------------------
1161C G l o b a l P a r a m e t e r s
1162C-----------------------------------------------
1163#include "mvsiz_p.inc"
1164C-----------------------------------------------
1165C C o m m o n B l o c k s
1166C-----------------------------------------------
1167#include "parit_c.inc"
1168#include "scr18_c.inc"
1169C-----------------------------------------------
1170C D u m m y A r g u m e n t s
1171C-----------------------------------------------
1172 INTEGER JLT,NISKYFI,NIN,NOINT,INTTH,IFORM,
1173 . isky(*),
1174 . ix1(mvsiz),ix2(mvsiz),ix3(mvsiz),ix4(mvsiz),nsvg(mvsiz)
1175 INTEGER ,INTENT(IN) :: NODADT_THERM
1176 my_real
1177 . H1(MVSIZ),H2(MVSIZ),H3(MVSIZ),H4(MVSIZ),STIF(MVSIZ),
1178 . FX1(MVSIZ),FY1(MVSIZ),FZ1(MVSIZ),
1179 . FX2(MVSIZ),FY2(MVSIZ),FZ2(MVSIZ),
1180 . FX3(MVSIZ),FY3(MVSIZ),FZ3(MVSIZ),
1181 . FX4(MVSIZ),FY4(MVSIZ),FZ4(MVSIZ),
1182 . FXI(MVSIZ),FYI(MVSIZ),FZI(MVSIZ),
1183 . FSKYI(LSKYI,NFSKYI),FTHESKYI(LSKYI),PHI(MVSIZ),CONDINT(MVSIZ),
1184 . PHI1(*),PHI2(*) ,PHI3(*) ,PHI4(*),CONDNSKYI(LSKYI)
1185C-----------------------------------------------
1186C L o c a l V a r i a b l e s
1187C-----------------------------------------------
1188 INTEGER I, J1, IG, NISKYL1, NISKYL,IGP,IGM,IDR,NISKYFIL
1189C
1190 niskyl1 = 0
1191 DO i = 1, jlt
1192 IF (h1(i)/=zero) niskyl1 = niskyl1 + 1
1193 ENDDO
1194 DO i = 1, jlt
1195 IF (h2(i)/=zero) niskyl1 = niskyl1 + 1
1196 ENDDO
1197 DO i = 1, jlt
1198 IF (h3(i)/=zero) niskyl1 = niskyl1 + 1
1199 ENDDO
1200 DO i = 1, jlt
1201 IF (h4(i)/=zero) niskyl1 = niskyl1 + 1
1202 ENDDO
1203C
1204C Precalcul impact locaux / remote {Local/remote impact pre-calculation}
1205C
1206 igp = 0
1207 igm = 0
1208 DO i=1,jlt
1209 ig =nsvg(i)
1210 IF(ig>0) THEN
1211 igp = igp+1
1212 ELSE
1213 igm = igm+1
1214 ENDIF
1215 ENDDO
1216C
1217#include "lockon.inc"
1218 niskyl = nisky
1219 nisky = nisky + niskyl1 + igp
1220 niskyfil = niskyfi
1221 niskyfi = niskyfi + igm
1222 !!debug
1223 !I0 = NISKYL+1
1224#include "lockoff.inc"
1225C
1226 IF (niskyl+niskyl1+igp > lskyi) THEN
1227 CALL ancmsg(msgid=26,anmode=aninfo)
1228 CALL arret(2)
1229 ENDIF
1230 IF (niskyfil+igm > nlskyfi(nin)) THEN
1231 CALL ancmsg(msgid=26,anmode=aninfo)
1232 CALL arret(2)
1233 ENDIF
1234 IF(intth == 0 ) THEN
1235 DO i=1,jlt
1236 IF (h1(i)/=0.) THEN
1237 niskyl = niskyl + 1
1238 fskyi(niskyl,1)=fx1(i)
1239 fskyi(niskyl,2)=fy1(i)
1240 fskyi(niskyl,3)=fz1(i)
1241 fskyi(niskyl,4)=stif(i)*abs(h1(i))
1242 isky(niskyl) = ix1(i)
1243 ENDIF
1244 ENDDO
1245 DO i=1,jlt
1246 IF (h2(i)/=zero) THEN
1247 niskyl = niskyl + 1
1248 fskyi(niskyl,1)=fx2(i)
1249 fskyi(niskyl,2)=fy2(i)
1250 fskyi(niskyl,3)=fz2(i)
1251 fskyi(niskyl,4)=stif(i)*abs(h2(i))
1252 isky(niskyl) = ix2(i)
1253 ENDIF
1254 ENDDO
1255 DO i=1,jlt
1256 IF (h3(i)/=zero) THEN
1257 niskyl = niskyl + 1
1258 fskyi(niskyl,1)=fx3(i)
1259 fskyi(niskyl,2)=fy3(i)
1260 fskyi(niskyl,3)=fz3(i)
1261 fskyi(niskyl,4)=stif(i)*abs(h3(i))
1262 isky(niskyl) = ix3(i)
1263 ENDIF
1264 ENDDO
1265 DO i=1,jlt
1266 IF (h4(i)/=zero) THEN
1267 niskyl = niskyl + 1
1268 fskyi(niskyl,1)=fx4(i)
1269 fskyi(niskyl,2)=fy4(i)
1270 fskyi(niskyl,3)=fz4(i)
1271 fskyi(niskyl,4)=stif(i)*abs(h4(i))
1272 isky(niskyl) = ix4(i)
1273 ENDIF
1274 ENDDO
1275C
1276 DO i=1,jlt
1277 ig =nsvg(i)
1278 IF(ig>0) THEN
1279 niskyl = niskyl + 1
1280 fskyi(niskyl,1)=-fxi(i)
1281 fskyi(niskyl,2)=-fyi(i)
1282 fskyi(niskyl,3)=-fzi(i)
1283 fskyi(niskyl,4)= stif(i)
1284 isky(niskyl) = ig
1285 ELSE
1286 ig = -ig
1287 niskyfil = niskyfil + 1
1288 fskyfi(nin)%P(1,niskyfil)=-fxi(i)
1289 fskyfi(nin)%P(2,niskyfil)=-fyi(i)
1290 fskyfi(nin)%P(3,niskyfil)=-fzi(i)
1291 fskyfi(nin)%P(4,niskyfil)= stif(i)
1292 iskyfi(nin)%P(niskyfil) = ig
1293 ENDIF
1294 ENDDO
1295C Thermique {Thermal}
1296 ELSE
1297 IF(nodadt_therm == 1 .AND.iform > 0) THEN
1298 DO i=1,jlt
1299 IF (h1(i)/=0.) THEN
1300 niskyl = niskyl + 1
1301 fskyi(niskyl,1)=fx1(i)
1302 fskyi(niskyl,2)=fy1(i)
1303 fskyi(niskyl,3)=fz1(i)
1304 fskyi(niskyl,4)=stif(i)*abs(h1(i))
1305 isky(niskyl) = ix1(i)
1306 ftheskyi(niskyl) = phi1(i)
1307 condnskyi(niskyl)=condint(i)*abs(h1(i))
1308 ENDIF
1309 ENDDO
1310 DO i=1,jlt
1311 IF (h2(i)/=zero) THEN
1312 niskyl = niskyl + 1
1313 fskyi(niskyl,1)=fx2(i)
1314 fskyi(niskyl,2)=fy2(i)
1315 fskyi(niskyl,3)=fz2(i)
1316 fskyi(niskyl,4)=stif(i)*abs(h2(i))
1317 isky(niskyl) = ix2(i)
1318 ftheskyi(niskyl) = phi2(i)
1319 condnskyi(niskyl)=condint(i)*abs(h2(i))
1320 ENDIF
1321 ENDDO
1322 DO i=1,jlt
1323 IF (h3(i)/=zero) THEN
1324 niskyl = niskyl + 1
1325 fskyi(niskyl,1)=fx3(i)
1326 fskyi(niskyl,2)=fy3(i)
1327 fskyi(niskyl,3)=fz3(i)
1328 fskyi(niskyl,4)=stif(i)*abs(h3(i))
1329 isky(niskyl) = ix3(i)
1330 ftheskyi(niskyl) = phi3(i)
1331 condnskyi(niskyl)=condint(i)*abs(h3(i))
1332 ENDIF
1333 ENDDO
1334 DO i=1,jlt
1335 IF (h4(i)/=zero) THEN
1336 niskyl = niskyl + 1
1337 fskyi(niskyl,1)=fx4(i)
1338 fskyi(niskyl,2)=fy4(i)
1339 fskyi(niskyl,3)=fz4(i)
1340 fskyi(niskyl,4)=stif(i)*abs(h4(i))
1341 isky(niskyl) = ix4(i)
1342 ftheskyi(niskyl) = phi4(i)
1343 condnskyi(niskyl)=condint(i)*abs(h4(i))
1344 ENDIF
1345 ENDDO
1346 ELSE
1347 DO i=1,jlt
1348 IF (h1(i)/=0.) THEN
1349 niskyl = niskyl + 1
1350 fskyi(niskyl,1)=fx1(i)
1351 fskyi(niskyl,2)=fy1(i)
1352 fskyi(niskyl,3)=fz1(i)
1353 fskyi(niskyl,4)=stif(i)*abs(h1(i))
1354 isky(niskyl) = ix1(i)
1355 ftheskyi(niskyl) = phi1(i)
1356 ENDIF
1357 ENDDO
1358 DO i=1,jlt
1359 IF (h2(i)/=zero) THEN
1360 niskyl = niskyl + 1
1361 fskyi(niskyl,1)=fx2(i)
1362 fskyi(niskyl,2)=fy2(i)
1363 fskyi(niskyl,3)=fz2(i)
1364 fskyi(niskyl,4)=stif(i)*abs(h2(i))
1365 isky(niskyl) = ix2(i)
1366 ftheskyi(niskyl) = phi2(i)
1367 ENDIF
1368 ENDDO
1369 DO i=1,jlt
1370 IF (h3(i)/=zero) THEN
1371 niskyl = niskyl + 1
1372 fskyi(niskyl,1)=fx3(i)
1373 fskyi(niskyl,2)=fy3(i)
1374 fskyi(niskyl,3)=fz3(i)
1375 fskyi(niskyl,4)=stif(i)*abs(h3(i))
1376 isky(niskyl) = ix3(i)
1377 ftheskyi(niskyl) = phi3(i)
1378 ENDIF
1379 ENDDO
1380 DO i=1,jlt
1381 IF (h4(i)/=zero) THEN
1382 niskyl = niskyl + 1
1383 fskyi(niskyl,1)=fx4(i)
1384 fskyi(niskyl,2)=fy4(i)
1385 fskyi(niskyl,3)=fz4(i)
1386 fskyi(niskyl,4)=stif(i)*abs(h4(i))
1387 isky(niskyl) = ix4(i)
1388 ftheskyi(niskyl) = phi4(i)
1389 ENDIF
1390 ENDDO
1391 ENDIF
1392C
1393 IF(nodadt_therm == 1) THEN
1394 DO i=1,jlt
1395 ig =nsvg(i)
1396 IF(ig>0) THEN
1397 niskyl = niskyl + 1
1398 fskyi(niskyl,1)=-fxi(i)
1399 fskyi(niskyl,2)=-fyi(i)
1400 fskyi(niskyl,3)=-fzi(i)
1401 fskyi(niskyl,4)= stif(i)
1402 isky(niskyl) = ig
1403 ftheskyi(niskyl)=phi(i)
1404 condnskyi(niskyl)=condint(i)
1405 ELSE
1406 ig = -ig
1407 niskyfil = niskyfil + 1
1408 fskyfi(nin)%P(1,niskyfil)=-fxi(i)
1409 fskyfi(nin)%P(2,niskyfil)=-fyi(i)
1410 fskyfi(nin)%P(3,niskyfil)=-fzi(i)
1411 fskyfi(nin)%P(4,niskyfil)= stif(i)
1412 iskyfi(nin)%P(niskyfil) = ig
1413 ftheskyfi(nin)%P(niskyfil)=phi(i)
1414 condnskyfi(nin)%P(niskyfil)=condint(i)
1415 ENDIF
1416 ENDDO
1417 ELSE
1418 DO i=1,jlt
1419 ig =nsvg(i)
1420 IF(ig>0) THEN
1421 niskyl = niskyl + 1
1422 fskyi(niskyl,1)=-fxi(i)
1423 fskyi(niskyl,2)=-fyi(i)
1424 fskyi(niskyl,3)=-fzi(i)
1425 fskyi(niskyl,4)= stif(i)
1426 isky(niskyl) = ig
1427 ftheskyi(niskyl)=phi(i)
1428 ELSE
1429 ig = -ig
1430 niskyfil = niskyfil + 1
1431 fskyfi(nin)%P(1,niskyfil)=-fxi(i)
1432 fskyfi(nin)%P(2,niskyfil)=-fyi(i)
1433 fskyfi(nin)%P(3,niskyfil)=-fzi(i)
1434 fskyfi(nin)%P(4,niskyfil)= stif(i)
1435 iskyfi(nin)%P(niskyfil) = ig
1436 ftheskyfi(nin)%P(niskyfil)=phi(i)
1437 ENDIF
1438 ENDDO
1439 ENDIF
1440 ENDIF
1441C
1442!#include "lockon.inc"
1443! DO i = 1,jlt
1444! WRITE(914,'(1X,I5,I5,3(1X,Z20))')I,NSVG(I),FXI(I),FYI(I),FZI(I)
1445! WRITE(914,'(1X,I5,I5,3(1X,Z20))')I,IX1(I),FX1(I),FY1(I),FZ1(I)
1446! WRITE(914,'(1X,I5,I5,3(1X,Z20))')I,IX2(I),FX2(I),FY2(I),FZ2(I)
1447! WRITE(914,'(1X,I5,I5,3(1X,Z20))')I,IX3(I),FX3(I),FY3(I),FZ3(I)
1448! WRITE(914,'(1X,I5,I5,3(1X,Z20))')I,IX4(I),FX4(I),FY4(I),FZ4(I)
1449! enddo
1450!#include "lockoff.inc"
1451C
1452 RETURN
1453 END
1454C
1455!||====================================================================
1456!|| i7ass25 ../engine/source/interfaces/int07/i7ass3.F
1457!||--- called by ------------------------------------------------------
1458!|| i10for3 ../engine/source/interfaces/int10/i10for3.F
1459!|| i20for3 ../engine/source/interfaces/int20/i20for3.F
1460!|| i23for3 ../engine/source/interfaces/int23/i23for3.F
1461!|| i7ass33 ../engine/source/interfaces/int07/i7ass3.F
1462!||--- calls -----------------------------------------------------
1463!|| ancmsg ../engine/source/output/message/message.F
1464!|| arret ../engine/source/system/arret.F
1465!||--- uses -----------------------------------------------------
1466!|| message_mod ../engine/share/message_module/message_mod.F
1467!|| tri7box ../engine/share/modules/tri7box.F
1468!||====================================================================
1469 SUBROUTINE i7ass25(JLT ,IX1 ,IX2 ,IX3 ,IX4 ,
1470 2 NSVG ,H1 ,H2 ,H3 ,H4 ,
1471 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,FZ2 ,
1472 4 FX3 ,FY3 ,FZ3 ,FX4 ,FY4 ,FZ4 ,
1473 5 FXI ,FYI ,FZI ,FSKYI,NISKYFI,NIN ,
1474 6 KS ,K1 ,K2 ,K3 ,K4 ,CS ,
1475 7 C1 ,C2 ,C3 ,C4 ,ISKY ,NOINT ,
1476 8 INTTH ,PHI ,FTHESKYI ,PHI1 ,PHI2 ,
1477 9 PHI3 ,PHI4 ,CONDNSKYI ,CONDINT,IFORM ,NODADT_THERM)
1478C-----------------------------------------------
1479C M o d u l e s
1480C-----------------------------------------------
1481 USE tri7box
1482 USE message_mod
1483C-----------------------------------------------
1484C I m p l i c i t T y p e s
1485C-----------------------------------------------
1486#include "implicit_f.inc"
1487#include "comlock.inc"
1488C-----------------------------------------------
1489C G l o b a l P a r a m e t e r s
1490C-----------------------------------------------
1491#include "mvsiz_p.inc"
1492C-----------------------------------------------
1493C C o m m o n B l o c k s
1494C-----------------------------------------------
1495#include "parit_c.inc"
1496#include "scr18_c.inc"
1497C-----------------------------------------------
1498C D u m m y A r g u m e n t s
1499C-----------------------------------------------
1500 INTEGER JLT,NISKYFI,NIN,INTTH,IFORM,
1501 . ISKY(*),NOINT,
1502 . IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),NSVG(MVSIZ)
1503 INTEGER ,INTENT(IN) :: NODADT_THERM
1504 my_real
1505 . H1(MVSIZ),H2(MVSIZ),H3(MVSIZ),H4(MVSIZ),
1506 . FX1(MVSIZ),FY1(MVSIZ),FZ1(MVSIZ),
1507 . FX2(MVSIZ),FY2(MVSIZ),FZ2(MVSIZ),
1508 . fx3(mvsiz),fy3(mvsiz),fz3(mvsiz),
1509 . fx4(mvsiz),fy4(mvsiz),fz4(mvsiz),
1510 . fxi(mvsiz),fyi(mvsiz),fzi(mvsiz),
1511 . ks(mvsiz),k1(mvsiz),k2(mvsiz),k3(mvsiz),k4(mvsiz),
1512 . cs(mvsiz),c1(mvsiz),c2(mvsiz),c3(mvsiz),c4(mvsiz),
1513 . fskyi(lskyi,nfskyi),ftheskyi(lskyi),phi(mvsiz),
1514 . phi1(mvsiz),phi2(mvsiz),phi3(mvsiz),phi4(mvsiz),
1515 . condint(mvsiz),condnskyi(lskyi)
1516C-----------------------------------------------
1517C L o c a l V a r i a b l e s
1518C-----------------------------------------------
1519 INTEGER I, J1, IG, NISKYL1, NISKYL,IGP,IGM,IDR,NISKYFIL
1520C
1521 NISKYL1 = 0
1522 do i = 1, jlt
1523 IF (h1(i)/=zero) niskyl1 = niskyl1 + 1
1524 ENDDO
1525 DO i = 1, jlt
1526 IF (h2(i)/=zero) niskyl1 = niskyl1 + 1
1527 ENDDO
1528 DO i = 1, jlt
1529 IF (h3(i)/=zero) niskyl1 = niskyl1 + 1
1530 ENDDO
1531 DO i = 1, jlt
1532 IF (h4(i)/=zero) niskyl1 = niskyl1 + 1
1533 ENDDO
1534C
1535C Precalcul impact locaux / remote {Local/remote impact pre-calculation}
1536C
1537 igp = 0
1538 igm = 0
1539 DO i=1,jlt
1540 ig =nsvg(i)
1541 IF(ig>0) THEN
1542 igp = igp+1
1543 ELSE
1544 igm = igm+1
1545 ENDIF
1546 ENDDO
1547C
1548#include "lockon.inc"
1549 niskyl = nisky
1550 nisky = nisky + niskyl1 + igp
1551 niskyfil = niskyfi
1552 niskyfi = niskyfi + igm
1553#include "lockoff.inc"
1554C
1555 IF (niskyl+niskyl1+igp > lskyi) THEN
1556 CALL ancmsg(msgid=26,anmode=aninfo)
1557 CALL arret(2)
1558 ENDIF
1559 IF (niskyfil+igm > nlskyfi(nin)) THEN
1560 CALL ancmsg(msgid=26,anmode=aninfo)
1561 CALL arret(2)
1562 ENDIF
1563C
1564Cs
1565 IF(intth == 0 ) THEN
1566 DO i=1,jlt
1567 IF (h1(i)/=0.) THEN
1568 niskyl = niskyl + 1
1569 fskyi(niskyl,1)=fx1(i)
1570 fskyi(niskyl,2)=fy1(i)
1571 fskyi(niskyl,3)=fz1(i)
1572 fskyi(niskyl,4)=k1(i)
1573 fskyi(niskyl,5)=c1(i)
1574 isky(niskyl) = ix1(i)
1575 ENDIF
1576 ENDDO
1577 DO i=1,jlt
1578 IF (h2(i)/=zero) THEN
1579 niskyl = niskyl + 1
1580 fskyi(niskyl,1)=fx2(i)
1581 fskyi(niskyl,2)=fy2(i)
1582 fskyi(niskyl,3)=fz2(i)
1583 fskyi(niskyl,4)=k2(i)
1584 fskyi(niskyl,5)=c2(i)
1585 isky(niskyl) = ix2(i)
1586 ENDIF
1587 ENDDO
1588 DO i=1,jlt
1589 IF (h3(i)/=zero) THEN
1590 niskyl = niskyl + 1
1591 fskyi(niskyl,1)=fx3(i)
1592 fskyi(niskyl,2)=fy3(i)
1593 fskyi(niskyl,3)=fz3(i)
1594 fskyi(niskyl,4)=k3(i)
1595 fskyi(niskyl,5)=c3(i)
1596 isky(niskyl) = ix3(i)
1597 ENDIF
1598 ENDDO
1599 DO i=1,jlt
1600 IF (h4(i)/=zero) THEN
1601 niskyl = niskyl + 1
1602 fskyi(niskyl,1)=fx4(i)
1603 fskyi(niskyl,2)=fy4(i)
1604 fskyi(niskyl,3)=fz4(i)
1605 fskyi(niskyl,4)=k4(i)
1606 fskyi(niskyl,5)=c4(i)
1607 isky(niskyl) = ix4(i)
1608 ENDIF
1609 ENDDO
1610 DO i=1,jlt
1611 ig = nsvg(i)
1612 IF(ig>0) THEN
1613 niskyl = niskyl + 1
1614 fskyi(niskyl,1)=-fxi(i)
1615 fskyi(niskyl,2)=-fyi(i)
1616 fskyi(niskyl,3)=-fzi(i)
1617 fskyi(niskyl,4)= ks(i)
1618 fskyi(niskyl,5)= cs(i)
1619 isky(niskyl) = ig
1620 ELSE
1621 ig = -ig
1622 niskyfil = niskyfil + 1
1623 fskyfi(nin)%P(1,niskyfil)=-fxi(i)
1624 fskyfi(nin)%P(2,niskyfil)=-fyi(i)
1625 fskyfi(nin)%P(3,niskyfil)=-fzi(i)
1626 fskyfi(nin)%P(4,niskyfil)= ks(i)
1627 fskyfi(nin)%P(5,niskyfil)= cs(i)
1628 iskyfi(nin)%P(niskyfil) = ig
1629 ENDIF
1630 ENDDO
1631C + la thermique {+ the thermal}
1632 ELSE
1633 IF(nodadt_therm == 1 .AND.iform > 0) THEN
1634 DO i=1,jlt
1635 IF (h1(i)/=0.) THEN
1636 niskyl = niskyl + 1
1637 fskyi(niskyl,1)=fx1(i)
1638 fskyi(niskyl,2)=fy1(i)
1639 fskyi(niskyl,3)=fz1(i)
1640 fskyi(niskyl,4)=k1(i)
1641 fskyi(niskyl,5)=c1(i)
1642 isky(niskyl) = ix1(i)
1643 ftheskyi(niskyl) = phi1(i)
1644 condnskyi(niskyl) = condint(i)*abs(h1(i))
1645 ENDIF
1646 ENDDO
1647 DO i=1,jlt
1648 IF (h2(i)/=zero) THEN
1649 niskyl = niskyl + 1
1650 fskyi(niskyl,1)=fx2(i)
1651 fskyi(niskyl,2)=fy2(i)
1652 fskyi(niskyl,3)=fz2(i)
1653 fskyi(niskyl,4)=k2(i)
1654 fskyi(niskyl,5)=c2(i)
1655 isky(niskyl) = ix2(i)
1656 ftheskyi(niskyl) = phi2(i)
1657 condnskyi(niskyl) = condint(i)*abs(h2(i))
1658 ENDIF
1659 ENDDO
1660 DO i=1,jlt
1661 IF (h3(i)/=zero) THEN
1662 niskyl = niskyl + 1
1663 fskyi(niskyl,1)=fx3(i)
1664 fskyi(niskyl,2)=fy3(i)
1665 fskyi(niskyl,3)=fz3(i)
1666 fskyi(niskyl,4)=k3(i)
1667 fskyi(niskyl,5)=c3(i)
1668 isky(niskyl) = ix3(i)
1669 ftheskyi(niskyl) = phi3(i)
1670 condnskyi(niskyl) = condint(i)*abs(h3(i))
1671 ENDIF
1672 ENDDO
1673 DO i=1,jlt
1674 IF (h4(i)/=zero) THEN
1675 niskyl = niskyl + 1
1676 fskyi(niskyl,1)=fx4(i)
1677 fskyi(niskyl,2)=fy4(i)
1678 fskyi(niskyl,3)=fz4(i)
1679 fskyi(niskyl,4)=k4(i)
1680 fskyi(niskyl,5)=c4(i)
1681 isky(niskyl) = ix4(i)
1682 ftheskyi(niskyl) = phi4(i)
1683 condnskyi(niskyl) = condint(i)*abs(h4(i))
1684 ENDIF
1685 ENDDO
1686 ELSE
1687 DO i=1,jlt
1688 IF (h1(i)/=0.) THEN
1689 niskyl = niskyl + 1
1690 fskyi(niskyl,1)=fx1(i)
1691 fskyi(niskyl,2)=fy1(i)
1692 fskyi(niskyl,3)=fz1(i)
1693 fskyi(niskyl,4)=k1(i)
1694 fskyi(niskyl,5)=c1(i)
1695 isky(niskyl) = ix1(i)
1696 ftheskyi(niskyl) = phi1(i)
1697 ENDIF
1698 ENDDO
1699 DO i=1,jlt
1700 IF (h2(i)/=zero) THEN
1701 niskyl = niskyl + 1
1702 fskyi(niskyl,1)=fx2(i)
1703 fskyi(niskyl,2)=fy2(i)
1704 fskyi(niskyl,3)=fz2(i)
1705 fskyi(niskyl,4)=k2(i)
1706 fskyi(niskyl,5)=c2(i)
1707 isky(niskyl) = ix2(i)
1708 ftheskyi(niskyl) = phi2(i)
1709 ENDIF
1710 ENDDO
1711 DO i=1,jlt
1712 IF (h3(i)/=zero) THEN
1713 niskyl = niskyl + 1
1714 fskyi(niskyl,1)=fx3(i)
1715 fskyi(niskyl,2)=fy3(i)
1716 fskyi(niskyl,3)=fz3(i)
1717 fskyi(niskyl,4)=k3(i)
1718 fskyi(niskyl,5)=c3(i)
1719 isky(niskyl) = ix3(i)
1720 ftheskyi(niskyl) = phi3(i)
1721 ENDIF
1722 ENDDO
1723 DO i=1,jlt
1724 IF (h4(i)/=zero) THEN
1725 niskyl = niskyl + 1
1726 fskyi(niskyl,1)=fx4(i)
1727 fskyi(niskyl,2)=fy4(i)
1728 fskyi(niskyl,3)=fz4(i)
1729 fskyi(niskyl,4)=k4(i)
1730 fskyi(niskyl,5)=c4(i)
1731 isky(niskyl) = ix4(i)
1732 ftheskyi(niskyl) = phi4(i)
1733 ENDIF
1734 ENDDO
1735 ENDIF
1736C
1737 IF(nodadt_therm == 1 ) THEN
1738 DO i=1,jlt
1739 ig = nsvg(i)
1740 IF(ig>0) THEN
1741 niskyl = niskyl + 1
1742 fskyi(niskyl,1)=-fxi(i)
1743 fskyi(niskyl,2)=-fyi(i)
1744 fskyi(niskyl,3)=-fzi(i)
1745 fskyi(niskyl,4)= ks(i)
1746 fskyi(niskyl,5)= cs(i)
1747 isky(niskyl) = ig
1748 ftheskyi(niskyl)=phi(i)
1749 condnskyi(niskyl)=condint(i)
1750 ELSE
1751 ig = -ig
1752 niskyfil = niskyfil + 1
1753 fskyfi(nin)%P(1,niskyfil)=-fxi(i)
1754 fskyfi(nin)%P(2,niskyfil)=-fyi(i)
1755 fskyfi(nin)%P(3,niskyfil)=-fzi(i)
1756 fskyfi(nin)%P(4,niskyfil)= ks(i)
1757 fskyfi(nin)%P(5,niskyfil)= cs(i)
1758 iskyfi(nin)%P(niskyfil) = ig
1759 ftheskyfi(nin)%P(niskyfil) =phi(i)
1760 condnskyfi(nin)%P(niskyfil) =condint(i)
1761 ENDIF
1762 ENDDO
1763 ELSE
1764 DO i=1,jlt
1765 ig = nsvg(i)
1766 IF(ig>0) THEN
1767 niskyl = niskyl + 1
1768 fskyi(niskyl,1)=-fxi(i)
1769 fskyi(niskyl,2)=-fyi(i)
1770 fskyi(niskyl,3)=-fzi(i)
1771 fskyi(niskyl,4)= ks(i)
1772 fskyi(niskyl,5)= cs(i)
1773 isky(niskyl) = ig
1774 ftheskyi(niskyl)=phi(i)
1775 ELSE
1776 ig = -ig
1777 niskyfil = niskyfil + 1
1778 fskyfi(nin)%P(1,niskyfil)=-fxi(i)
1779 fskyfi(nin)%P(2,niskyfil)=-fyi(i)
1780 fskyfi(nin)%P(3,niskyfil)=-fzi(i)
1781 fskyfi(nin)%P(4,niskyfil)= ks(i)
1782 fskyfi(nin)%P(5,niskyfil)= cs(i)
1783 iskyfi(nin)%P(niskyfil) = ig
1784 ftheskyfi(nin)%P(niskyfil) =phi(i)
1785 ENDIF
1786 ENDDO
1787 ENDIF
1788 ENDIF
1789C
1790 RETURN
1791 END
1792!||====================================================================
1793!|| i7assigeo0 ../engine/source/interfaces/int07/i7ass3.F
1794!||--- called by ------------------------------------------------------
1795!|| i7ass33 ../engine/source/interfaces/int07/i7ass3.F
1796!||--- calls -----------------------------------------------------
1797!|| ig3donebasis ../engine/source/elements/ige3d/ig3donebasis.F
1798!||--- uses -----------------------------------------------------
1799!|| h3d_mod ../engine/share/modules/h3d_mod.F
1800!|| message_mod ../engine/share/message_module/message_mod.F
1801!|| tri7box ../engine/share/modules/tri7box.F
1802!||====================================================================
1803 SUBROUTINE i7assigeo0(JLT ,IX1 ,IX2 ,IX3 ,IX4 ,
1804 2 NSVG ,H1 ,H2 ,H3 ,H4 ,STIF ,
1805 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,FZ2 ,
1806 4 FX3 ,FY3 ,FZ3 ,FX4 ,FY4 ,FZ4 ,
1807 5 FXI ,FYI ,FZI ,A ,STIFN ,IXIG3D,
1808 6 KXIG3D,X ,WIGE ,KNOT ,IGEO ,NIGE ,
1809 7 RIGE ,FCONT,H3D_DATA,KNOTLOCPC,KNOTLOCEL)
1810C-----------------------------------------------
1811C M o d u l e s
1812C-----------------------------------------------
1813 USE tri7box
1814 USE message_mod
1815 USE h3d_mod
1816C-----------------------------------------------
1817C I m p l i c i t T y p e s
1818C-----------------------------------------------
1819#include "implicit_f.inc"
1820C-----------------------------------------------
1821C G l o b a l P a r a m e t e r s
1822C-----------------------------------------------
1823#include "mvsiz_p.inc"
1824C-----------------------------------------------
1825C C o m m o n B l o c k s
1826C-----------------------------------------------
1827#include "param_c.inc"
1828#include "scr14_c.inc"
1829#include "com04_c.inc"
1830#include "ige3d_c.inc"
1831C-----------------------------------------------
1832C D u m m y A r g u m e n t s
1833C-----------------------------------------------
1834 INTEGER JLT,IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),
1835 . nsvg(mvsiz),kxig3d(nixig3d,*),ixig3d(*),
1836 . igeo(npropgi,*),nige(*)
1837 my_real
1838 . h1(mvsiz),h2(mvsiz),h3(mvsiz),h4(mvsiz),stif(mvsiz),
1839 . fx1(mvsiz),fy1(mvsiz),fz1(mvsiz),
1840 . fx2(mvsiz),fy2(mvsiz),fz2(mvsiz),
1841 . fx3(mvsiz),fy3(mvsiz),fz3(mvsiz),
1842 . fx4(mvsiz),fy4(mvsiz),fz4(mvsiz),
1843 . fxi(mvsiz),fyi(mvsiz),fzi(mvsiz),
1844 . a(3,*), stifn(*), fcont(3,*)
1845 my_real
1846 . x(3,*),wige(*),knot(*),rige(3,*),
1847 . knotlocpc(deg_max,3,*),knotlocel(2,3,*)
1848 TYPE(h3d_database) :: H3D_DATA
1849C-----------------------------------------------
1850C L o c a l V a r i a b l e s
1851C-----------------------------------------------
1852 INTEGER I, J, JS, IPID, IAD_KNOT, NKNOT1,
1853 . nknot2, nknot3, idx, idy, idz, n1, n2, n3,
1854 . nctrl, ierror, ig, numcp(64), k, idx2, idy2, idz2,
1855 . idfrstlocknt,idpc,px,py,pz, j1
1856 my_real
1857 . zr,zs,zt
1858 my_real
1859 . x_igeo(64),y_igeo(64),z_igeo(64),
1860 . w_igeo(64),r(64),
1861 . fx(mvsiz),fy(mvsiz),fz(mvsiz),knotlocelx(2,jlt),
1862 . knotlocely(2,jlt),knotlocelz(2,jlt)
1863 my_real, DIMENSION(:,:), ALLOCATABLE :: knotlocx, knotlocy, knotlocz
1864C======================================================================|
1865
1866C-------------------------------------
1867C Force Assembly
1868C-------------------------------------
1869
1870 DO i=1,jlt
1871
1872 IF(ix1(i)<=numnod) THEN
1873 j1=ix1(i)
1874 a(1,j1)=a(1,j1)+fx1(i)
1875 a(2,j1)=a(2,j1)+fy1(i)
1876 a(3,j1)=a(3,j1)+fz1(i)
1877 stifn(j1) = stifn(j1) + stif(i)*abs(h1(i))
1878 cycle
1879 ENDIF
1880
1881 js=nige(ix1(i)-numnod)
1882c print*,'JS main ', JS, KXIG3D(2,JS)
1883 ipid=kxig3d(2,js)
1884 nctrl = kxig3d(3,js)
1885 iad_knot = igeo(40,ipid)
1886 px = igeo(41,ipid)
1887 py = igeo(42,ipid)
1888 pz = igeo(43,ipid)
1889 n1 = igeo(44,ipid)
1890 n2 = igeo(45,ipid)
1891 n3 = igeo(46,ipid)
1892 idfrstlocknt = igeo(47,ipid)
1893 nknot1 = n1+px
1894 nknot2 = n2+py
1895 nknot3 = n3+pz
1896 idx = kxig3d(6,js)
1897 idy = kxig3d(7,js)
1898 idz = kxig3d(8,js)
1899 idx2 = kxig3d(9,js)
1900 idy2 = kxig3d(10,js)
1901 idz2 = kxig3d(11,js)
1902
1903
1904 DO j=1,nctrl
1905 k = ixig3d(kxig3d(4,js)+j-1)
1906 numcp(j) =k
1907 x_igeo(j)=x(1,k)
1908 y_igeo(j)=x(2,k)
1909 z_igeo(j)=x(3,k)
1910 w_igeo(j)=1!WIGE(K)
1911 ENDDO
1912
1913 ALLOCATE(knotlocx(px+1,nctrl),knotlocy(py+1,nctrl),knotlocz(pz+1,nctrl))
1914
1915 DO j=1,nctrl
1916 DO k=1,px+1
1917 knotlocx(k,j)=knotlocpc(k,1,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
1918 ENDDO
1919 DO k=1,py+1
1920 knotlocy(k,j)=knotlocpc(k,2,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
1921 ENDDO
1922 DO k=1,pz+1
1923 knotlocz(k,j)=knotlocpc(k,3,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
1924 ENDDO
1925 ENDDO
1926
1927 knotlocelx(1,i) = knotlocel(1,1,js)
1928 knotlocely(1,i) = knotlocel(1,2,js)
1929 knotlocelz(1,i) = knotlocel(1,3,js)
1930 knotlocelx(2,i) = knotlocel(2,1,js)
1931 knotlocely(2,i) = knotlocel(2,2,js)
1932 knotlocelz(2,i) = knotlocel(2,3,js)
1933
1934 zr = rige(1,ix1(i)-numnod)
1935 zs = rige(2,ix1(i)-numnod)
1936 zt = rige(3,ix1(i)-numnod)
1937
1938 CALL ig3donebasis(
1939 1 js ,0 ,x_igeo(:) ,y_igeo(:),
1940 2 z_igeo(:),w_igeo(:) ,idx ,idy ,
1941 3 idz ,knotlocx ,knotlocy,knotlocz,
1942 4 r ,nctrl ,
1943 5 zr ,zs ,zt ,knot(iad_knot+1),
1944 6 knot(iad_knot+nknot1+1),knot(iad_knot+nknot1+nknot2+1),px-1,
1945 7 py-1 ,pz-1 ,0 ,
1946 8 idx2 ,idy2 ,idz2 ,
1947 9 knotlocelx(:,i),knotlocely(:,i),knotlocelz(:,i))
1948
1949 DO j=1,nctrl
1950 k = numcp(j)
1951 IF(anim_v(4)+h3d_data%N_VECT_CONT >0)THEN
1952 fcont(1,k) = fcont(1,k) + r(j)*fx1(i)
1953 fcont(2,k) = fcont(2,k) + r(j)*fy1(i)
1954 fcont(3,k) = fcont(3,k) + r(j)*fz1(i)
1955 ENDIF
1956 a(1,k) = a(1,k) + r(j)*fx1(i)
1957 a(2,k) = a(2,k) + r(j)*fy1(i)
1958 a(3,k) = a(3,k) + r(j)*fz1(i)
1959 stifn(k) = stifn(k) + stif(i)*abs(h1(i))*r(j)
1960 ENDDO
1961
1962 DEALLOCATE(knotlocx,knotlocy,knotlocz)
1963
1964 ENDDO
1965
1966 DO i=1,jlt
1967
1968 IF(ix2(i)<=numnod) THEN
1969 j1=ix2(i)
1970 a(1,j1)=a(1,j1)+fx2(i)
1971 a(2,j1)=a(2,j1)+fy2(i)
1972 a(3,j1)=a(3,j1)+fz2(i)
1973 stifn(j1) = stifn(j1) + stif(i)*abs(h2(i))
1974 cycle
1975 ENDIF
1976
1977 js=nige(ix2(i)-numnod)
1978 ipid=kxig3d(2,js)
1979 nctrl = kxig3d(3,js)
1980 iad_knot = igeo(40,ipid)
1981 px = igeo(41,ipid)
1982 py = igeo(42,ipid)
1983 pz = igeo(43,ipid)
1984 n1 = igeo(44,ipid)
1985 n2 = igeo(45,ipid)
1986 n3 = igeo(46,ipid)
1987 nknot1 = n1+px
1988 nknot2 = n2+py
1989 nknot3 = n3+pz
1990 idx = kxig3d(6,js)
1991 idy = kxig3d(7,js)
1992 idz = kxig3d(8,js)
1993
1994 DO j=1,nctrl
1995 k = ixig3d(kxig3d(4,js)+j-1)
1996 numcp(j) =k
1997 x_igeo(j)=x(1,k)
1998 y_igeo(j)=x(2,k)
1999 z_igeo(j)=x(3,k)
2000 w_igeo(j)=1!WIGE(K)
2001 ENDDO
2002
2003 ALLOCATE(knotlocx(px+1,nctrl),knotlocy(py+1,nctrl),knotlocz(pz+1,nctrl))
2004
2005 DO j=1,nctrl
2006 DO k=1,px+1
2007 knotlocx(k,j)=knotlocpc(k,1,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
2008 ENDDO
2009 DO k=1,py+1
2010 knotlocy(k,j)=knotlocpc(k,2,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
2011 ENDDO
2012 DO k=1,pz+1
2013 knotlocz(k,j)=knotlocpc(k,3,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
2014 ENDDO
2015 ENDDO
2016
2017 knotlocelx(1,i) = knotlocel(1,1,js)
2018 knotlocely(1,i) = knotlocel(1,2,js)
2019 knotlocelz(1,i) = knotlocel(1,3,js)
2020 knotlocelx(2,i) = knotlocel(2,1,js)
2021 knotlocely(2,i) = knotlocel(2,2,js)
2022 knotlocelz(2,i) = knotlocel(2,3,js)
2023
2024 zr = rige(1,ix2(i)-numnod)
2025 zs = rige(2,ix2(i)-numnod)
2026 zt = rige(3,ix2(i)-numnod)
2027
2028c CALL IGE3DBASIS(
2029c 1 JS ,0 ,X_IGEO(:) ,Y_IGEO(:) ,
2030c 2 Z_IGEO(:) ,W_IGEO(:) ,IDX ,IDY ,
2031c 3 IDZ ,R ,
2032c 4 NCTRL ,ZR ,ZS ,ZT ,
2033c 5 KNOT(IAD_KNOT+1) ,KNOT(IAD_KNOT+NKNOT1+1),
2034c 6 KNOT(IAD_KNOT+NKNOT1+NKNOT2+1) ,PX-1 ,
2035c 7 PY-1 ,PZ-1 ,0)
2036
2037 CALL ig3donebasis(
2038 1 js ,0 ,x_igeo(:) ,y_igeo(:),
2039 2 z_igeo(:),w_igeo(:) ,idx ,idy ,
2040 3 idz ,knotlocx ,knotlocy,knotlocz,
2041 4 r ,nctrl ,
2042 5 zr ,zs ,zt ,knot(iad_knot+1),
2043 6 knot(iad_knot+nknot1+1),knot(iad_knot+nknot1+nknot2+1),px-1,
2044 7 py-1 ,pz-1 ,0 ,
2045 8 idx2 ,idy2 ,idz2 ,
2046 9 knotlocelx(:,i),knotlocely(:,i),knotlocelz(:,i))
2047
2048 DO j=1,nctrl
2049 k = numcp(j)
2050 IF(anim_v(4)+h3d_data%N_VECT_CONT >0)THEN
2051 fcont(1,k) = fcont(1,k) + r(j)*fx2(i)
2052 fcont(2,k) = fcont(2,k) + r(j)*fy2(i)
2053 fcont(3,k) = fcont(3,k) + r(j)*fz2(i)
2054 ENDIF
2055 a(1,k) = a(1,k) + r(j)*fx2(i)
2056 a(2,k) = a(2,k) + r(j)*fy2(i)
2057 a(3,k) = a(3,k) + r(j)*fz2(i)
2058 stifn(k) = stifn(k) + stif(i)*abs(h2(i))*r(j)
2059 ENDDO
2060
2061 DEALLOCATE(knotlocx,knotlocy,knotlocz)
2062
2063 ENDDO
2064
2065 DO i=1,jlt
2066
2067 IF(ix3(i)<=numnod) THEN
2068 j1=ix3(i)
2069 a(1,j1)=a(1,j1)+fx3(i)
2070 a(2,j1)=a(2,j1)+fy3(i)
2071 a(3,j1)=a(3,j1)+fz3(i)
2072 stifn(j1) = stifn(j1) + stif(i)*abs(h3(i))
2073 cycle
2074 ENDIF
2075
2076 js=nige(ix3(i)-numnod)
2077 ipid=kxig3d(2,js)
2078 nctrl = kxig3d(3,js)
2079 iad_knot = igeo(40,ipid)
2080 px = igeo(41,ipid)
2081 py = igeo(42,ipid)
2082 pz = igeo(43,ipid)
2083 n1 = igeo(44,ipid)
2084 n2 = igeo(45,ipid)
2085 n3 = igeo(46,ipid)
2086 nknot1 = n1+px
2087 nknot2 = n2+py
2088 nknot3 = n3+pz
2089 idx = kxig3d(6,js)
2090 idy = kxig3d(7,js)
2091 idz = kxig3d(8,js)
2092
2093 DO j=1,nctrl
2094 k = ixig3d(kxig3d(4,js)+j-1)
2095 numcp(j) =k
2096 x_igeo(j)=x(1,k)
2097 y_igeo(j)=x(2,k)
2098 z_igeo(j)=x(3,k)
2099 w_igeo(j)=1!WIGE(K)
2100 ENDDO
2101
2102 ALLOCATE(knotlocx(px+1,nctrl),knotlocy(py+1,nctrl),knotlocz(pz+1,nctrl))
2103
2104 DO j=1,nctrl
2105 DO k=1,px+1
2106 knotlocx(k,j)=knotlocpc(k,1,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
2107 ENDDO
2108 DO k=1,py+1
2109 knotlocy(k,j)=knotlocpc(k,2,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
2110 ENDDO
2111 DO k=1,pz+1
2112 knotlocz(k,j)=knotlocpc(k,3,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
2113 ENDDO
2114 ENDDO
2115
2116 knotlocelx(1,i) = knotlocel(1,1,js)
2117 knotlocely(1,i) = knotlocel(1,2,js)
2118 knotlocelz(1,i) = knotlocel(1,3,js)
2119 knotlocelx(2,i) = knotlocel(2,1,js)
2120 knotlocely(2,i) = knotlocel(2,2,js)
2121 knotlocelz(2,i) = knotlocel(2,3,js)
2122
2123 zr = rige(1,ix3(i)-numnod)
2124 zs = rige(2,ix3(i)-numnod)
2125 zt = rige(3,ix3(i)-numnod)
2126
2127c CALL IGE3DBASIS(
2128c 1 JS ,0 ,X_IGEO(:) ,Y_IGEO(:) ,
2129c 2 Z_IGEO(:) ,W_IGEO(:) ,IDX ,IDY ,
2130c 3 IDZ ,R ,
2131c 4 NCTRL ,ZR ,ZS ,ZT ,
2132c 5 KNOT(IAD_KNOT+1) ,KNOT(IAD_KNOT+NKNOT1+1),
2133c 6 KNOT(IAD_KNOT+NKNOT1+NKNOT2+1) ,PX-1 ,
2134c 7 PY-1 ,PZ-1 ,0)
2135
2136 CALL ig3donebasis(
2137 1 js ,0 ,x_igeo(:) ,y_igeo(:),
2138 2 z_igeo(:),w_igeo(:) ,idx ,idy ,
2139 3 idz ,knotlocx ,knotlocy,knotlocz,
2140 4 r ,nctrl ,
2141 5 zr ,zs ,zt ,knot(iad_knot+1),
2142 6 knot(iad_knot+nknot1+1),knot(iad_knot+nknot1+nknot2+1),px-1,
2143 7 py-1 ,pz-1 ,0 ,
2144 8 idx2 ,idy2 ,idz2 ,
2145 9 knotlocelx(:,i),knotlocely(:,i),knotlocelz(:,i))
2146
2147 DO j=1,nctrl
2148 k = numcp(j)
2149 IF(anim_v(4)+h3d_data%N_VECT_CONT >0)THEN
2150 fcont(1,k) = fcont(1,k) + r(j)*fx3(i)
2151 fcont(2,k) = fcont(2,k) + r(j)*fy3(i)
2152 fcont(3,k) = fcont(3,k) + r(j)*fz3(i)
2153 ENDIF
2154 a(1,k) = a(1,k) + r(j)*fx3(i)
2155 a(2,k) = a(2,k) + r(j)*fy3(i)
2156 a(3,k) = a(3,k) + r(j)*fz3(i)
2157 stifn(k) = stifn(k) + stif(i)*abs(h3(i))*r(j)
2158 ENDDO
2159
2160 DEALLOCATE(knotlocx,knotlocy,knotlocz)
2161
2162 ENDDO
2163
2164 DO i=1,jlt
2165
2166 IF(ix4(i)<=numnod) THEN
2167 j1=ix4(i)
2168 a(1,j1)=a(1,j1)+fx4(i)
2169 a(2,j1)=a(2,j1)+fy4(i)
2170 a(3,j1)=a(3,j1)+fz4(i)
2171 stifn(j1) = stifn(j1) + stif(i)*abs(h4(i))
2172 cycle
2173 ENDIF
2174
2175 js=nige(ix4(i)-numnod)
2176 ipid=kxig3d(2,js)
2177 nctrl = kxig3d(3,js)
2178 iad_knot = igeo(40,ipid)
2179 px = igeo(41,ipid)
2180 py = igeo(42,ipid)
2181 pz = igeo(43,ipid)
2182 n1 = igeo(44,ipid)
2183 n2 = igeo(45,ipid)
2184 n3 = igeo(46,ipid)
2185 nknot1 = n1+px
2186 nknot2 = n2+py
2187 nknot3 = n3+pz
2188 idx = kxig3d(6,js)
2189 idy = kxig3d(7,js)
2190 idz = kxig3d(8,js)
2191
2192 DO j=1,nctrl
2193 k = ixig3d(kxig3d(4,js)+j-1)
2194 numcp(j) =k
2195 x_igeo(j)=x(1,k)
2196 y_igeo(j)=x(2,k)
2197 z_igeo(j)=x(3,k)
2198 w_igeo(j)=1!WIGE(K)
2199 ENDDO
2200
2201 ALLOCATE(knotlocx(px+1,nctrl),knotlocy(py+1,nctrl),knotlocz(pz+1,nctrl))
2202
2203 DO j=1,nctrl
2204 DO k=1,px+1
2205 knotlocx(k,j)=knotlocpc(k,1,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
2206 ENDDO
2207 DO k=1,py+1
2208 knotlocy(k,j)=knotlocpc(k,2,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
2209 ENDDO
2210 DO k=1,pz+1
2211 knotlocz(k,j)=knotlocpc(k,3,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
2212 ENDDO
2213 ENDDO
2214
2215 knotlocelx(1,i) = knotlocel(1,1,js)
2216 knotlocely(1,i) = knotlocel(1,2,js)
2217 knotlocelz(1,i) = knotlocel(1,3,js)
2218 knotlocelx(2,i) = knotlocel(2,1,js)
2219 knotlocely(2,i) = knotlocel(2,2,js)
2220 knotlocelz(2,i) = knotlocel(2,3,js)
2221
2222 zr = rige(1,ix4(i)-numnod)
2223 zs = rige(2,ix4(i)-numnod)
2224 zt = rige(3,ix4(i)-numnod)
2225
2226 CALL ig3donebasis(
2227 1 js ,0 ,x_igeo(:) ,y_igeo(:),
2228 2 z_igeo(:),w_igeo(:) ,idx ,idy ,
2229 3 idz ,knotlocx ,knotlocy,knotlocz,
2230 4 r ,nctrl ,
2231 5 zr ,zs ,zt ,knot(iad_knot+1),
2232 6 knot(iad_knot+nknot1+1),knot(iad_knot+nknot1+nknot2+1),px-1,
2233 7 py-1 ,pz-1 ,0 ,
2234 8 idx2 ,idy2 ,idz2 ,
2235 9 knotlocelx(:,i),knotlocely(:,i),knotlocelz(:,i))
2236
2237 DO j=1,nctrl
2238 k = numcp(j)
2239 IF(anim_v(4)+h3d_data%N_VECT_CONT >0)THEN
2240 fcont(1,k) = fcont(1,k) + r(j)*fx4(i)
2241 fcont(2,k) = fcont(2,k) + r(j)*fy4(i)
2242 fcont(3,k) = fcont(3,k) + r(j)*fz4(i)
2243 ENDIF
2244c print*,'R', R(J)
2245c print*,'A(J)',A(1,K),A(2,K),A(3,K)
2246 a(1,k) = a(1,k) + r(j)*fx4(i)
2247 a(2,k) = a(2,k) + r(j)*fy4(i)
2248 a(3,k) = a(3,k) + r(j)*fz4(i)
2249c print*,'F', FX4(I),FY4(I),FZ4(I)
2250c print*,'A(J)',A(1,K),A(2,K),A(3,K)
2251 stifn(k) = stifn(k) + stif(i)*abs(h4(i))*r(j)
2252 ENDDO
2253
2254 DEALLOCATE(knotlocx,knotlocy,knotlocz)
2255C
2256 ENDDO
2257
2258C-------------------------------------
2259C ASSEMBLAGE FORCES - COTE SECOND
2260C-------------------------------------
2261
2262 fx(:) = 0
2263 fy(:) = 0
2264 fz(:) = 0
2265
2266 DO i=1,jlt
2267 ig=nsvg(i)
2268 IF(ig<=numnod)THEN
2269 a(1,ig)=a(1,ig)-fxi(i)
2270 a(2,ig)=a(2,ig)-fyi(i)
2271 a(3,ig)=a(3,ig)-fzi(i)
2272 stifn(ig) = stifn(ig) + stif(i)
2273 ENDIF
2274 ENDDO
2275
2276 DO i=1,jlt
2277 ig=nsvg(i)
2278 IF(nsvg(i)<=numnod) cycle
2279 js=nige(ig-numnod)
2280 nctrl = kxig3d(3,js)
2281 DO j=1,nctrl
2282 k = ixig3d(kxig3d(4,js)+j-1)
2283 numcp(j) =k
2284 x_igeo(j)=x(1,k)
2285 y_igeo(j)=x(2,k)
2286 z_igeo(j)=x(3,k)
2287 w_igeo(j)=1!WIGE(K)
2288 ENDDO
2289 ipid=kxig3d(2,js)
2290 nctrl = kxig3d(3,js)
2291 iad_knot = igeo(40,ipid)
2292 px = igeo(41,ipid)
2293 py = igeo(42,ipid)
2294 pz = igeo(43,ipid)
2295 n1 = igeo(44,ipid)
2296 n2 = igeo(45,ipid)
2297 n3 = igeo(46,ipid)
2298 idfrstlocknt = igeo(47,ipid)
2299 nknot1 = n1+px
2300 nknot2 = n2+py
2301 nknot3 = n3+pz
2302 idx = kxig3d(6,js)
2303 idy = kxig3d(7,js)
2304 idz = kxig3d(8,js)
2305 idx2 = kxig3d(9,js)
2306 idy2 = kxig3d(10,js)
2307 idz2 = kxig3d(11,js)
2308
2309
2310 ALLOCATE(knotlocx(px+1,nctrl),knotlocy(py+1,nctrl),knotlocz(pz+1,nctrl))
2311
2312 DO j=1,nctrl
2313 DO k=1,px+1
2314 knotlocx(k,j)=knotlocpc(k,1,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
2315 ENDDO
2316 DO k=1,py+1
2317 knotlocy(k,j)=knotlocpc(k,2,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
2318 ENDDO
2319 DO k=1,pz+1
2320 knotlocz(k,j)=knotlocpc(k,3,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
2321 ENDDO
2322 ENDDO
2323
2324 knotlocelx(1,i) = knotlocel(1,1,js)
2325 knotlocely(1,i) = knotlocel(1,2,js)
2326 knotlocelz(1,i) = knotlocel(1,3,js)
2327 knotlocelx(2,i) = knotlocel(2,1,js)
2328 knotlocely(2,i) = knotlocel(2,2,js)
2329 knotlocelz(2,i) = knotlocel(2,3,js)
2330
2331 zr = rige(1,ig-numnod)
2332 zs = rige(2,ig-numnod)
2333 zt = rige(3,ig-numnod)
2334
2335 CALL ig3donebasis(
2336 1 js ,0 ,x_igeo(:) ,y_igeo(:),
2337 2 z_igeo(:),w_igeo(:) ,idx ,idy ,
2338 3 idz ,knotlocx ,knotlocy,knotlocz,
2339 4 r ,nctrl ,
2340 5 zr ,zs ,zt ,knot(iad_knot+1),
2341 6 knot(iad_knot+nknot1+1),knot(iad_knot+nknot1+nknot2+1),px-1,
2342 7 py-1 ,pz-1 ,0 ,
2343 8 idx2,idy2 ,idz2 ,
2344 9 knotlocelx(:,i),knotlocely(:,i),knotlocelz(:,i))
2345
2346
2347 DO j=1,nctrl
2348 k = numcp(j)
2349 IF(anim_v(4)+h3d_data%N_VECT_CONT >0)THEN
2350 fcont(1,k) = fcont(1,k) - r(j)*fxi(i)
2351 fcont(2,k) = fcont(2,k) - r(j)*fyi(i)
2352 fcont(3,k) = fcont(3,k) - r(j)*fzi(i)
2353 ENDIF
2354 a(1,k) = a(1,k) - r(j)*fxi(i)
2355 a(2,k) = a(2,k) - r(j)*fyi(i)
2356 a(3,k) = a(3,k) - r(j)*fzi(i)
2357 stifn(k) = stifn(k) + stif(i)*r(j)
2358
2359 fx(j) = fx(j) + r(j)*fxi(i)
2360 fy(j) = fy(j) + r(j)*fyi(i)
2361 fz(j) = fz(j) + r(j)*fzi(i)
2362 ENDDO
2363
2364 DEALLOCATE(knotlocx,knotlocy,knotlocz)
2365
2366 ENDDO
2367
2368 RETURN
2369 END
2370
double_flot_ieee
subroutine double_flot_ieee(jft, jlt, i8, r8, i8f)
Definition cinmas.F:27
my_real
#define my_real
Definition cppsort.cpp:32
i10for3
subroutine i10for3(jlt, a, ms, v, fsav, cand_f, stifn, stif, fskyi, isky, itied, visc, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, nsvg, nx1, nx2, nx3, nx4, ny1, ny2, ny3, ny4, nz1, nz2, nz3, nz4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, p1, p2, p3, p4, fcont, ix1, ix2, ix3, ix4, gapv, index, niskyfi, isecin, nstrf, secfcum, noint, viscn, vxi, vyi, vzi, msi, nin, nisub, lisub, addsubs, addsubm, lisubs, lisubm, cn_loc, ce_loc, fsavsub, fncont, ftcont, mskyi_sms, iskyi_sms, nsms, xi, yi, zi, icontact, dt2t, neltst, ityptst, jtask, isensint, fsavparit, nft, h3d_data, nodadt_therm)
Definition i10for3.F:58
i7ass0
subroutine i7ass0(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, stif, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, a, stifn, nin, intth, phi, fthe, phi1, phi2, phi3, phi4, condn, condint, jtask, iform, nodadt_therm)
Definition i7ass3.F:718
i7assigeo0
subroutine i7assigeo0(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, stif, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, a, stifn, ixig3d, kxig3d, x, wige, knot, igeo, nige, rige, fcont, h3d_data, knotlocpc, knotlocel)
Definition i7ass3.F:1810
i7ass35
subroutine i7ass35(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, stif, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, i8a, i8stifn, i8viscn, ks, k1, k2, k3, k4, cs, c1, c2, c3, c4)
Definition i7ass3.F:507
i7ass3
subroutine i7ass3(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, stif, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, i8a, i8stifn)
Definition i7ass3.F:332
i7ass2
subroutine i7ass2(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, stif, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, fskyi, isky, niskyfi, nin, noint, intth, phi, ftheskyi, phi1, phi2, phi3, phi4, condnskyi, condint, iform, nodadt_therm)
Definition i7ass3.F:1150
i7ass05
subroutine i7ass05(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, a, stifn, viscn, ks, k1, k2, k3, k4, cs, c1, c2, c3, c4, nin, intth, phi, fthe, phi1, phi2, phi3, phi4, jtask, condn, condint, iform, nodadt_therm)
Definition i7ass3.F:936
i7ass33
subroutine i7ass33(jlt, a, noint, itab, stifn, stif, fskyi, isky, fcont, ix1, ix2, ix3, ix4, nsvg, neltst, ityptst, dt2t, niskyfi, isecin, nstrf, secfcum, viscn, nin, fxi, fyi, fzi, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, h1, h2, h3, h4, ks, kt, k1, k2, k3, k4, cs, cf, c1, c2, c3, c4, c, intth, phi, phi1, phi2, phi3, phi4, fthe, ftheskyi, mskyi_sms, iskyi_sms, nsms, dtmini, jtask, condn, condint, condnskyi, ixig3d, kxig3d, wige, knot, igeo, nige, rige, x, h3d_data, knotlocpc, knotlocel, iform, nodadt_therm)
Definition i7ass3.F:58
i7ass25
subroutine i7ass25(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, fskyi, niskyfi, nin, ks, k1, k2, k3, k4, cs, c1, c2, c3, c4, isky, noint, intth, phi, ftheskyi, phi1, phi2, phi3, phi4, condnskyi, condint, iform, nodadt_therm)
Definition i7ass3.F:1478
i7sms2
subroutine i7sms2(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, stif, nin, noint, mskyi_sms, iskyi_sms, nsms, kt, c, cf, dtmini, dti)
Definition i7sms2.F:40
h3d_mod
Definition h3d_mod.F:308
message_mod
Definition message_mod.F:1249
tri7box::condnfi
type(real_pointer), dimension(:), allocatable condnfi
Definition tri7box.F:449
tri7box::ftheskyfi
type(real_pointer), dimension(:), allocatable ftheskyfi
Definition tri7box.F:449
tri7box::condnskyfi
type(real_pointer), dimension(:), allocatable condnskyfi
Definition tri7box.F:449
tri7box::stnfi
type(real_pointer), dimension(:), allocatable stnfi
Definition tri7box.F:449
tri7box::afi
type(real_pointer2), dimension(:), allocatable afi
Definition tri7box.F:459
tri7box::fskyfi
type(real_pointer2), dimension(:), allocatable fskyfi
Definition tri7box.F:459
tri7box::iskyfi
type(int_pointer), dimension(:), allocatable iskyfi
Definition tri7box.F:480
tri7box::vscfi
type(real_pointer), dimension(:), allocatable vscfi
Definition tri7box.F:449
tri7box::nlskyfi
integer, dimension(:), allocatable nlskyfi
Definition tri7box.F:512
tri7box::fthefi
type(real_pointer), dimension(:), allocatable fthefi
Definition tri7box.F:449
ig3donebasis
subroutine ig3donebasis(itel, n, xxi, yyi, zzi, wwi, idx, idy, idz, knotlocx, knotlocy, knotlocz, r, nctrl, gaussx, gaussy, gaussz, kx, ky, kz, px, py, pz, boolg, idx2, idy2, idz2, knotlocelx, knotlocely, knotlocelz)
Definition ig3donebasis.F:42
ancmsg
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)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87
h3d_mod::h3d_database
Definition h3d_mod.F:435