OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i20mainf.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!|| i20mainf ../engine/source/interfaces/int20/i20mainf.f
25!||--- called by ------------------------------------------------------
26!|| intfop2 ../engine/source/interfaces/interf/intfop2.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| i11cdcor3 ../engine/source/interfaces/int11/i11cdcor3.F
31!|| i20cor3 ../engine/source/interfaces/int20/i20cor3.F
32!|| i20cor3e ../engine/source/interfaces/int20/i20cor3.F
33!|| i20dst3 ../engine/source/interfaces/int20/i20dst3.F
34!|| i20dst3e ../engine/source/interfaces/int20/i20cor3.F
35!|| i20for3 ../engine/source/interfaces/int20/i20for3.F
36!|| i20for3c ../engine/source/interfaces/int20/i20for3.F
37!|| i20for3e ../engine/source/interfaces/int20/i20for3.F
38!|| i20norm ../engine/source/interfaces/int20/i20curv.F
39!|| i20normcnt ../engine/source/interfaces/int20/i20curv.F
40!|| i20norme ../engine/source/interfaces/int20/i20rcurv.F
41!|| i20normn ../engine/source/interfaces/int20/i20rcurv.F
42!|| i20normnp ../engine/source/interfaces/int20/i20rcurv.F
43!|| i20normp ../engine/source/interfaces/int20/i20curv.F
44!|| i20norms ../engine/source/interfaces/int20/i20curv.F
45!|| i20rcurv ../engine/source/interfaces/int20/i20rcurv.F
46!|| i7cdcor3 ../engine/source/interfaces/int07/i7cdcor3.F
47!|| i7therm ../engine/source/interfaces/int07/i7therm.F
48!|| my_barrier ../engine/source/system/machine.F
49!|| spmd_exch_n ../engine/source/mpi/generic/spmd_exch_n.F
50!|| spmd_i20curvsz ../engine/source/mpi/interfaces/spmd_i20curvsz.F
51!|| spmd_i20exch_n ../engine/source/mpi/interfaces/spmd_i20exch_n.F
52!|| spmd_i20normf ../engine/source/mpi/interfaces/spmd_i20normf.F
53!|| startime ../engine/source/system/timer_mod.F90
54!|| stoptime ../engine/source/system/timer_mod.F90
55!|| sum_6_float_sens ../engine/source/system/parit.f
56!||--- uses -----------------------------------------------------
57!|| h3d_mod ../engine/share/modules/h3d_mod.F
58!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
59!|| message_mod ../engine/share/message_module/message_mod.f
60!|| output_mod ../common_source/modules/output/output_mod.F90
61!|| timer_mod ../engine/source/system/timer_mod.F90
62!||====================================================================
63 SUBROUTINE i20mainf(OUTPUT,TIMERS,
64 1 IPARI ,X ,A ,
65 2 ICODT ,FSAV ,V ,MS ,DT2T ,
66 3 NELTST ,ITYPTST ,ITAB ,STIFN ,FSKYI ,
67 4 ISKY ,FCONT ,NIN ,LINDMAX ,KINET ,
68 5 JTASK ,NB_JLT ,NB_JLT_NEW,NB_STOK_N ,
69 6 NISKYFI ,NEWFRONT ,NSTRF ,SECFCUM ,ICONTACT ,
70 7 VISCN ,NUM_IMP ,
71 9 NS_IMP ,NE_IMP ,IND_IMP ,FSAVSUB ,NRTMDIM ,
72 A FSAVBAG ,
73 B EMINX ,IXS ,IXS16 ,IXS20 ,FNCONT ,
74 C FTCONT ,IAD_ELEM ,FR_ELEM ,RCONTACT ,ACONTACT ,
75 D PCONTACT ,TEMP ,FTHE ,FTHESKYI ,
76 E PM ,IPARG ,IAD17 ,WEIGHT ,NISKYFIE ,
77 F IRLEN20 ,ISLEN20 ,IRLEN20T ,ISLEN20T ,IRLEN20E ,
78 G ISLEN20E ,MSKYI_SMS ,ISKYI_SMS ,NODNX_SMS ,NPC ,
79 H TF ,INTBUF_TAB,FBSAV6 ,ISENSINT ,DIMFB ,
80 I H3D_DATA ,theaccfact)
81C=======================================================================
82C-----------------------------------------------
83C M o d u l e s
84C-----------------------------------------------
85 USE output_mod
86 USE timer_mod
87 USE intbufdef_mod
88 USE h3d_mod
89 USE message_mod
90C-----------------------------------------------
91C I m p l i c i t T y p e s
92C-----------------------------------------------
93#include "implicit_f.inc"
94C-----------------------------------------------
95C G l o b a l P a r a m e t e r s
96C-----------------------------------------------
97#include "mvsiz_p.inc"
98C-----------------------------------------------
99C C o m m o n B l o c k s
100C-----------------------------------------------
101#include "com01_c.inc"
102#include "com04_c.inc"
103#include "com08_c.inc"
104#include "param_c.inc"
105#include "warn_c.inc"
106#include "task_c.inc"
107#include "parit_c.inc"
108#include "timeri_c.inc"
109C-----------------------------------------------
110C D u m m y A r g u m e n t s
111C-----------------------------------------------
112 type(output_), intent(inout) :: output
113 INTEGER NELTST,ITYPTST,NIN,NEWFRONT,NSTRF(*),
114 . NRTMDIM, IAD17, IRLEN20, ISLEN20, IRLEN20T, ISLEN20T,
115 . IRLEN20E, ISLEN20E, DIMFB
116 INTEGER IPARI(NPARI), ICODT(*),ICONTACT(*),
117 . ITAB(*), ISKY(*), KINET(*),
118 . WEIGHT(*),IPARG(NPARG,*)
119 INTEGER NB_JLT,NB_JLT_NEW,NB_STOK_N,JTASK,
120 . NISKYFI, LINDMAX, NISKYFIE
121 INTEGER NUM_IMP,NS_IMP(*),NE_IMP(*),IND_IMP(*)
122 INTEGER IXS(*) ,IXS16(*) ,IXS20(*)
123 INTEGER IAD_ELEM(2,*),FR_ELEM(*),
124 . ISKYI_SMS(*), NODNX_SMS(*),NPC(*), ISENSINT(*)
125 my_real, intent(in) :: theaccfact
126 my_real :: EMINX(*)
127 my_real DT2T,
128 . X(*), A(3,*), FSAV(*), V(3,*),FSAVBAG(*),
129 . MS(*),STIFN(*),FSKYI(LSKYI,4),FCONT(3,*),
130 . SECFCUM(7,NUMNOD,NSECT),VISCN(*), FSAVSUB(*),
131 . FNCONT(3,*), FTCONT(3,*), RCONTACT(*), ACONTACT(*),
132 . PCONTACT(*),
133 . TEMP(*),FTHE(*),FTHESKYI(LSKYI),PM(NPROPM,*),
134 . MSKYI_SMS(*),TF(*)
135
136 DOUBLE PRECISION FBSAV6(12,6,DIMFB)
137 TYPE(TIMER_) :: TIMERS
138 TYPE(INTBUF_STRUCT_) INTBUF_TAB
139 TYPE(H3D_DATABASE) :: H3D_DATA
140C=======================================================================
141C ALLOCATABLE
142C=======================================================================
143C-----------------------------------------------
144C L o c a l V a r i a b l e s
145C-----------------------------------------------
146 INTEGER I, I_STOK, JLT_NEW, JLT , NFT, IVIS2,
147 . IBC, NOINT, ISECIN, IBAG, IADM,
148 . IGAP, INACTI, IFQ, MFROT, IGSTI, NISUB,
149 . NB_LOC, I_STOK_LOC,DEBUT,
150 . LENR, LENT, MAXCC,INTTH,IFORM,
151 . NLN, NRTMFT, NRTMLT, NMNFT, NMNLT, NRADM,
152 . NLNFT1, NLNLT, NLNL, IFUNCTK, SFSAVPARIT, J, H, IERROR
153 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
154 . NSVG(MVSIZ), CN_LOC(MVSIZ),CE_LOC(MVSIZ),
155 . CAND_N_N(MVSIZ),CAND_E_N(MVSIZ),KINI(MVSIZ),
156 . INDEX2(LINDMAX),
157 . ISDSIZ(NSPMD+1),IRCSIZ(NSPMD+1),ITAG(NUMNOD),
158 . IELECI(MVSIZ)
159C REAL
160 my_real
161 . STARTT, FRIC, GAP, STOPT,
162 . VISC,VISCF,STIGLO,GAPMIN,
163 . KMIN, KMAX, GAPMAX,RSTIF,FHEAT,TINT,FRAD,DRAD,
164 . XTHE,FHEATM,FHEATS
165C-----------------------------------------------
166C REAL
167 my_real
168 . NX1(MVSIZ), NX2(MVSIZ), NX3(MVSIZ), NX4(MVSIZ),
169 . NY1(MVSIZ), NY2(MVSIZ), NY3(MVSIZ), NY4(MVSIZ),
170 . NZ1(MVSIZ), NZ2(MVSIZ), NZ3(MVSIZ), NZ4(MVSIZ),
171 . LB1(MVSIZ), LB2(MVSIZ), LB3(MVSIZ), LB4(MVSIZ),
172 . LC1(MVSIZ), LC2(MVSIZ), LC3(MVSIZ), LC4(MVSIZ),
173 . P1(MVSIZ), P2(MVSIZ), P3(MVSIZ), P4(MVSIZ),
174 . X1(MVSIZ), X2(MVSIZ), X3(MVSIZ), X4(MVSIZ),
175 . Y1(MVSIZ), Y2(MVSIZ), Y3(MVSIZ), Y4(MVSIZ),
176 . Z1(MVSIZ), Z2(MVSIZ), Z3(MVSIZ), Z4(MVSIZ),
177 . XI(MVSIZ), YI(MVSIZ), ZI(MVSIZ), STIF(MVSIZ),
178 .
179 . H1(MVSIZ), H2(MVSIZ), H3(MVSIZ), H4(MVSIZ),
180 . GAPV(MVSIZ),VXI(MVSIZ),VYI(MVSIZ),VZI(MVSIZ),MSI(MVSIZ),
181 . GAPR(MVSIZ),TEMPI(MVSIZ),PHI(MVSIZ),AREASI(MVSIZ)
182 my_real
183 . NX(MVSIZ),NY(MVSIZ),NZ(MVSIZ),
184 . HS1(MVSIZ), HS2(MVSIZ), HM1(MVSIZ), HM2(MVSIZ),
185 . XXS1(MVSIZ), XXS2(MVSIZ), XYS1(MVSIZ), XYS2(MVSIZ),
186 . XZS1(MVSIZ), XZS2(MVSIZ), XXM1(MVSIZ), XXM2(MVSIZ),
187 . XYM1(MVSIZ), XYM2(MVSIZ), XZM1(MVSIZ), XZM2(MVSIZ),
188 . VXS1(MVSIZ), VXS2(MVSIZ), VYS1(MVSIZ), VYS2(MVSIZ),
189 . VZS1(MVSIZ), VZS2(MVSIZ), VXM1(MVSIZ), VXM2(MVSIZ),
190 . VYM1(MVSIZ), VYM2(MVSIZ), VZM1(MVSIZ), VZM2(MVSIZ),
191 . MS1(MVSIZ), MS2(MVSIZ), MM1(MVSIZ), MM2(MVSIZ)
192 my_real
193 . RCURVI(MVSIZ), ANGLMI(MVSIZ), ANGLT, PADM
194 my_real
195 . NNX1(MVSIZ), NNX2(MVSIZ), NNX3(MVSIZ), NNX4(MVSIZ),
196 . NNY1(MVSIZ), NNY2(MVSIZ), NNY3(MVSIZ), NNY4(MVSIZ),
197 . NNZ1(MVSIZ), NNZ2(MVSIZ), NNZ3(MVSIZ), NNZ4(MVSIZ),
198 . CMAJ(MVSIZ),CONDINT(MVSIZ),FNI(MVSIZ),
199 . PHI1(MVSIZ),PHI2(MVSIZ),PHI3(MVSIZ),PHI4(MVSIZ),EFRICT(MVSIZ)
200 INTEGER N1(MVSIZ), N2(MVSIZ), M1(MVSIZ), M2(MVSIZ),
201 . NL1(MVSIZ), NL2(MVSIZ),ML1(MVSIZ), ML2(MVSIZ),
202 . CS_LOC(MVSIZ), CM_LOC(MVSIZ), NSMS(MVSIZ)
203 INTEGER ICURV,IMPL_S0
204 my_real, DIMENSION(:,:,:), ALLOCATABLE :: FSAVPARIT
205 INTEGER NSN, NTY, NLINSA
206C
207 NSN =IPARI(5)
208 NTY =IPARI(7)
209 IBC =IPARI(11)
210 IVIS2 =IPARI(14)
211 IF(IPARI(33) == 1) RETURN
212 NOINT =IPARI(15)
213 IGAP =IPARI(21)
214 INACTI=IPARI(22)
215 ISECIN=IPARI(28)
216 MFROT =IPARI(30)
217 IFQ =IPARI(31)
218 IBAG =IPARI(32)
219 IGSTI=IPARI(34)
220 NLN =IPARI(35)
221 NISUB =IPARI(36)
222 ICURV =IPARI(39)
223C adaptive meshing
224 IADM =IPARI(44)
225
226 NRADM=IPARI(49)
227 PADM =INTBUF_TAB%VARIABLES(24)
228 ANGLT=INTBUF_TAB%VARIABLES(25)
229C heat interface
230 INTTH = IPARI(47)
231 IFORM = IPARI(48)
232C
233 STIGLO=-INTBUF_TAB%STFAC(1)
234 STARTT=INTBUF_TAB%VARIABLES(3)
235 STOPT =INTBUF_TAB%VARIABLES(11)
236 IF(STARTT > TT) RETURN
237 IF(TT > STOPT) RETURN
238C
239 FRIC =INTBUF_TAB%VARIABLES(1)
240 GAP =INTBUF_TAB%VARIABLES(2)
241 GAPMIN=INTBUF_TAB%VARIABLES(13)
242 VISC =INTBUF_TAB%VARIABLES(14)
243 VISCF =INTBUF_TAB%VARIABLES(15)
244C
245 GAPMAX=INTBUF_TAB%VARIABLES(16)
246 KMIN =INTBUF_TAB%VARIABLES(17)
247 KMAX =INTBUF_TAB%VARIABLES(18)
248C
249 RSTIF = INTBUF_TAB%VARIABLES(20)
250 FHEAT = INTBUF_TAB%VARIABLES(21)
251 TINT = INTBUF_TAB%VARIABLES(22)
252 FRAD = ZERO
253 DRAD = ZERO
254C----deactive implicit part
255 IMPL_S0 =0
256 IF (IMPL_S0 == 1) THEN
257 NUM_IMP = 0
258 VISC =ZERO
259 VISCF =ZERO
260 ENDIF
261 IFUNCTK = 0
262 XTHE = ZERO
263 FHEATM = ZERO
264 FHEATS = ZERO
265C----------------------------------------------------------------------
266C NODES/SURFACE
267C----------------------------------------------------------------------
268
269c----------------------------------------------------
270c calculation of nodal normals
271c quadratic curvature or igap/=0 for solids (gap=0)
272c----------------------------------------------------
273
274 IF(IGAP/=0)THEN
275 CALL MY_BARRIER
276 IF(JTASK==1)THEN
277 ALLOCATE(INTBUF_TAB%SOLIDN_NORMAL (3,NUMNOD))
278 CALL I20NORMS(IPARI(4),INTBUF_TAB%IRECTM,NUMNOD,X,INTBUF_TAB%SOLIDN_NORMAL,
279 2 IPARI(6),INTBUF_TAB%MSR,NLN,INTBUF_TAB%NLG,INTBUF_TAB%GAP_SH,
280 3 IAD_ELEM,FR_ELEM,INTBUF_TAB%NSV,NSN)
281
282 IF(NSPMD > 1)THEN
283 LENR = IAD_ELEM(1,NSPMD+1)-IAD_ELEM(1,1)
284 CALL SPMD_I20EXCH_N(INTBUF_TAB%SOLIDN_NORMAL,IAD_ELEM,FR_ELEM,LENR)
285C Normal supplementary communication on proc remote in SPMD
286C NSNR Size NSNR (NB NODES STEND remote) allowance allowance
287 ALLOCATE(INTBUF_TAB%SOLIDN_NORMAL_F (3,IPARI(24)))
288C EDGE Party allowance on size n line (nb second remote lines)
289 ALLOCATE(INTBUF_TAB%SOLIDN_NORMAL_FE(3,2*IPARI(57)))
290 CALL SPMD_I20NORMF(
291 1 INTBUF_TAB%SOLIDN_NORMAL,INTBUF_TAB%SOLIDN_NORMAL_F,INTBUF_TAB%SOLIDN_NORMAL_FE,NIN ,IRLEN20 ,
292 2 ISLEN20 ,IRLEN20T ,ISLEN20T ,IRLEN20E,ISLEN20E,
293 3 INTBUF_TAB%NSV,INTBUF_TAB%NLG ,INTBUF_TAB%IXLINS )
294 END IF
295C this is the barrier matching that of i20norm on task1
296 END IF
297 CALL MY_BARRIER()
298 ENDIF
299c----------------------------------------------------
300c calculation of nodal normals
301c quadratic curvature or igap/=0 for solids (gap=0)
302c----------------------------------------------------
303 IF(ICURV==3)THEN
304 CALL MY_BARRIER()
305 IF(JTASK==1)THEN
306 ALLOCATE(INTBUF_TAB%NODNORM_NORMAL (3,NUMNOD))
307 IF(IPARIT==0)THEN
308 CALL I20NORM(IPARI(4),INTBUF_TAB%IRECTM,NUMNOD,X,INTBUF_TAB%NODNORM_NORMAL,
309 . IPARI(6),INTBUF_TAB%MSR,NLN,INTBUF_TAB%NLG)
310cc CALL MY_BARRIER()
311 IF(NSPMD>1)THEN
312 LENR = IAD_ELEM(1,NSPMD+1)-IAD_ELEM(1,1)
313 CALL SPMD_EXCH_N(INTBUF_TAB%NODNORM_NORMAL,IAD_ELEM,FR_ELEM,LENR)
314 END IF
315 ELSE
316C Traitement d'assemblage parith/on spmd a optimiser si besoin
317 LENR = IAD_ELEM(1,NSPMD+1)-IAD_ELEM(1,1)
318 IF(NSPMD > 1)THEN
319 CALL SPMD_I20CURVSZ(
320 1 IPARI(4),INTBUF_TAB%IRECTM,NUMNOD,IAD_ELEM,FR_ELEM,
321 2 ISDSIZ ,IRCSIZ ,ITAG ,LENR ,LENT ,
322 3 MAXCC ,NLN ,INTBUF_TAB%NLG)
323 ELSE
324 CALL I20NORMCNT(
325 1 IPARI(4),INTBUF_TAB%IRECTM,NUMNOD ,ITAG ,LENT ,
326 2 MAXCC ,NLN ,INTBUF_TAB%NLG)
327 ENDIF
328 CALL I20NORMP(
329 1 IPARI(4),INTBUF_TAB%IRECTM,NUMNOD ,X ,INTBUF_TAB%NODNORM_NORMAL,
330 2 IPARI(6),INTBUF_TAB%MSR,LENT ,MAXCC,ISDSIZ ,
331 3 IRCSIZ ,IAD_ELEM ,FR_ELEM,ITAG ,NLN,INTBUF_TAB%NLG)
332 END IF
333cc ELSE
334cc CALL MY_BARRIER()
335C this is the barrier matching that of i20norm on task1
336 END IF
337 CALL MY_BARRIER()
338 ENDIF
339c----------------------------------------------------
340c radius of curvature: calculation of nodal normals (normalized)
341C IADM!=0 + Icurv!=0 non available (starter error).
342c----------------------------------------------------
343 IF(IADM/=0)THEN
344 CALL MY_BARRIER()
345 IF(JTASK==1)THEN
346 ALLOCATE(INTBUF_TAB%MODRCURV(NRTMDIM),INTBUF_TAB%MODANGLM(NRTMDIM))
347 ALLOCATE(INTBUF_TAB%NODNORM_NORMAL (3,NUMNOD))
348
349 IF(IPARIT==0)THEN
350 CALL I20NORMN(
351 . IPARI(4),INTBUF_TAB%IRECTM,NUMNOD,X ,INTBUF_TAB%NODNORM_NORMAL,
352 . IPARI(6),INTBUF_TAB%MSR,NLN,INTBUF_TAB%NLG)
353cc CALL MY_BARRIER()
354 IF(NSPMD>1)THEN
355 LENR = IAD_ELEM(1,NSPMD+1)-IAD_ELEM(1,1)
356 CALL SPMD_EXCH_N(INTBUF_TAB%NODNORM_NORMAL,IAD_ELEM,FR_ELEM,LENR)
357 END IF
358 ELSE
359C Traitement d'assemblage parith/on spmd a optimiser si besoin
360 LENR = IAD_ELEM(1,NSPMD+1)-IAD_ELEM(1,1)
361 IF(NSPMD > 1)THEN
362 CALL SPMD_I20CURVSZ(
363 1 IPARI(4),INTBUF_TAB%IRECTM,NUMNOD,IAD_ELEM,FR_ELEM,
364 2 ISDSIZ ,IRCSIZ ,ITAG ,LENR ,LENT ,
365 3 MAXCC ,NLN ,INTBUF_TAB%NLG)
366 ELSE
367 CALL I20NORMCNT(
368 1 IPARI(4),INTBUF_TAB%IRECTM,NUMNOD ,ITAG ,LENT ,
369 2 MAXCC ,NLN ,INTBUF_TAB%NLG)
370
371 ENDIF
372 CALL I20NORMNP(
373 1 IPARI(4),INTBUF_TAB%IRECTM,NUMNOD ,X ,INTBUF_TAB%NODNORM_NORMAL,
374 2 IPARI(6),INTBUF_TAB%MSR,LENT ,MAXCC,ISDSIZ ,
375 3 IRCSIZ ,IAD_ELEM ,FR_ELEM,ITAG ,NLN,INTBUF_TAB%NLG)
376
377 END IF
378cc ELSE
379cc CALL MY_BARRIER()
380C this is the barrier matching that of i7normn on task1
381 END IF
382 CALL MY_BARRIER()
383
384 NMNFT=1+(JTASK-1)*IPARI(6)/NTHREAD
385 NMNLT=JTASK*IPARI(6)/NTHREAD
386
387 CALL I20NORME(
388 . NMNFT,NMNLT,INTBUF_TAB%NODNORM_NORMAL,INTBUF_TAB%MSR,NLN,INTBUF_TAB%NLG)
389 CALL MY_BARRIER()
390
391 NRTMFT=1+(JTASK-1)*IPARI(4)/NTHREAD
392 NRTMLT=JTASK*IPARI(4)/NTHREAD
393 CALL I20RCURV(NRTMFT, NRTMLT ,X ,INTBUF_TAB%NODNORM_NORMAL ,INTBUF_TAB%IRECTM ,
394 . INTBUF_TAB%MODRCURV , NRADM ,INTBUF_TAB%MODANGLM ,ANGLT,NLN,INTBUF_TAB%NLG )
395 CALL MY_BARRIER()
396 END IF
397C----------------------------------------------------
398C
399 I_STOK = INTBUF_TAB%I_STOK(1)
400C static decoupage
401 NB_LOC = I_STOK / NTHREAD
402 IF (JTASK==NTHREAD) THEN
403 I_STOK_LOC = I_STOK-NB_LOC*(NTHREAD-1)
404 ELSE
405 I_STOK_LOC = NB_LOC
406 ENDIF
407 DEBUT = (JTASK-1)*NB_LOC
408
409 I_STOK = 0
410C
411C
412C recalculation of istok
413C
414 DO I = DEBUT+1, DEBUT+I_STOK_LOC
415 IF(INTBUF_TAB%CAND_N(I) < 0) THEN
416 I_STOK = I_STOK + 1
417 INDEX2(I_STOK) = I
418C inbuf == cand_n
419 INTBUF_TAB%CAND_N(I) = -INTBUF_TAB%CAND_N(I)
420 ENDIF
421 ENDDO
422c------------------------------------------------
423 IF (DEBUG(3)>=1) THEN
424 NB_JLT = NB_JLT + I_STOK_LOC
425 NB_STOK_N = NB_STOK_N + I_STOK
426 ENDIF
427c------------------------------------------------
428C
429 SFSAVPARIT = 0
430 DO I=1,NISUB+1
431 IF(ISENSINT(I)/=0) THEN
432 SFSAVPARIT = SFSAVPARIT + 1
433 ENDIF
434 ENDDO
435 IF (SFSAVPARIT /= 0) THEN
436 ALLOCATE(FSAVPARIT(NISUB+1,11,I_STOK),STAT=IERROR)
437 IF(IERROR/=0) THEN
438 CALL ANCMSG(MSGID=19,ANMODE=ANINFO,
439 . C1='(/INTER/TYPE20)')
440 CALL ARRET(2)
441 ENDIF
442 DO J=1,I_STOK
443 DO I=1,11
444 DO H=1,NISUB+1
445 FSAVPARIT(H,I,J) = ZERO
446 ENDDO
447 ENDDO
448 ENDDO
449 ELSE
450 ALLOCATE(FSAVPARIT(0,0,0),STAT=IERROR)
451 IF(IERROR/=0) THEN
452 CALL ANCMSG(MSGID=19,ANMODE=ANINFO,
453 . C1='(/INTER/TYPE20)')
454 CALL ARRET(2)
455 ENDIF
456 ENDIF
457c
458 DO NFT = 0 , I_STOK - 1 , NVSIZ
459c------------------------------------------------
460 JLT = MIN( NVSIZ, I_STOK - NFT )
461C preparation CANDIDATES retenus
462 CALL I7CDCOR3(
463 1 JLT,INDEX2(NFT+1),INTBUF_TAB%CAND_E,INTBUF_TAB%CAND_N,
464 2 CAND_E_N,CAND_N_N)
465C cand_n and cand_e replaced by cand_n_n and cand_e_n
466 CALL I20COR3(
467 1 JLT ,INTBUF_TAB%XA,INTBUF_TAB%IRECTM,INTBUF_TAB%NSV,CAND_E_N,
468 2 CAND_N_N ,INTBUF_TAB%STFM,INTBUF_TAB%STFA,X1 ,X2 ,
469 3 X3 ,X4 ,Y1 ,Y2 ,Y3 ,
470 4 Y4 ,Z1 ,Z2 ,Z3 ,Z4 ,
471 5 XI ,YI ,ZI ,STIF ,IX1 ,
472 6 IX2 ,IX3 ,IX4 ,NSVG ,IGAP ,
473 7 GAP ,INTBUF_TAB%GAP_S,INTBUF_TAB%GAP_M,GAPV ,GAPR ,
474 8 MS ,VXI ,VYI ,NLN ,INTBUF_TAB%NLG,
475 9 VZI ,MSI ,NSN ,INTBUF_TAB%VA,KINET ,
476 A KINI ,NTY ,NIN ,IGSTI ,KMIN ,
477 B KMAX ,GAPMAX ,GAPMIN ,IADM ,INTBUF_TAB%MODRCURV ,
478 C RCURVI ,INTBUF_TAB%MODANGLM ,ANGLMI ,INTTH ,TEMP ,
479 D TEMPI ,PHI ,INTBUF_TAB%AREAS,INTBUF_TAB%IELEC,AREASI ,
480 E IELECI ,INTBUF_TAB%GAP_SH,INTBUF_TAB%STFAC,NODNX_SMS,NSMS )
481C
482 JLT_NEW = 0
483C
484 CALL I20DST3(
485 1 JLT ,CAND_N_N ,CAND_E_N ,CN_LOC ,CE_LOC ,
486 2 X1 ,X2 ,X3 ,X4 ,Y1 ,
487 3 Y2 ,Y3 ,Y4 ,Z1 ,Z2 ,
488 4 Z3 ,Z4 ,XI ,YI ,ZI ,
489 5 NX1 ,NX2 ,NX3 ,NX4 ,NY1 ,
490 6 NY2 ,NY3 ,NY4 ,NZ1 ,NZ2 ,
491 7 NZ3 ,NZ4 ,LB1 ,LB2 ,LB3 ,
492 8 LB4 ,LC1 ,LC2 ,LC3 ,LC4 ,
493 9 P1 ,P2 ,P3 ,P4 ,IX1 ,
494 A IX2 ,IX3 ,IX4 ,NSVG ,STIF ,
495 B JLT_NEW ,GAPV ,INACTI ,INTBUF_TAB%SOLIDN_NORMAL,
496 C INDEX2(NFT+1),VXI ,VYI ,GAPR ,INTBUF_TAB%GAP_SH,
497 D VZI ,MSI ,KINI ,ICURV ,INTBUF_TAB%IRECTM,
498 E NNX1 ,NNX2 ,NNX3 ,NNX4 ,NNY1 ,
499 F NNY2 ,NNY3 ,NNY4 ,NNZ1 ,NNZ2 ,
500 G NNZ3 ,NNZ4 ,INTBUF_TAB%NODNORM_NORMAL ,IADM ,RCURVI ,
501 H ANGLMI ,INTTH ,TEMPI ,PHI ,AREASI ,
502 I IELECI ,NLN ,INTBUF_TAB%NLG,IGAP ,GAPMAX ,
503 J INTBUF_TAB%SOLIDN_NORMAL_F ,NSMS ,INTBUF_TAB%NBINFLG,INTBUF_TAB%GAP_M,
504 K CMAJ)
505 JLT = JLT_NEW
506.AND. IF (IMONM > 0 JTASK == 1) CALL STARTIME(TIMERS,20)
507 IF(JLT_NEW/=0) THEN
508 IPARI(29) = 1
509 IF (DEBUG(3)>=1)NB_JLT_NEW = NB_JLT_NEW + JLT_NEW
510C
511 IF( INTTH > 0 ) THEN
512 CALL I7THERM(JLT ,IPARG ,PM ,IXS ,IFORM ,X ,
513 1 XI ,YI ,ZI ,X1 ,Y1 ,Z1 ,
514 2 X2 ,Y2 ,Z2 ,X3 ,Y3 ,Z3 ,
515 3 X4 ,Y4 ,Z4 ,IX1 ,IX2 ,IX3 ,
516 4 IX4 ,RSTIF ,TEMPI, INTBUF_TAB%IELEC,
517 5 PHI ,TINT ,AREASI, IELECI,FRAD,DRAD ,
518 6 GAPV ,FNI ,IFUNCTK,XTHE,NPC ,TF ,
519 7 CONDINT,PHI1,PHI2 ,PHI3 ,PHI4 ,FHEATS,
520 7 FHEATM,EFRICT,TEMP ,H1 ,H2 ,H3 ,
521 8 H4,theaccfact)
522 ENDIF
523C
524 CALL I20FOR3(output,
525 1 JLT ,A ,INTBUF_TAB%VA,IBC ,ICODT ,
526 2 FSAV ,GAP ,FRIC ,MS ,VISC ,
527 3 VISCF ,NOINT ,INTBUF_TAB%STFA,ITAB ,CN_LOC ,
528 4 STIGLO ,STIFN ,STIF ,FSKYI ,ISKY ,
529 5 NX1 ,NX2 ,NX3 ,NX4 ,NY1 ,
530 6 NY2 ,NY3 ,NY4 ,NZ1 ,NZ2 ,
531 7 NZ3 ,NZ4 ,LB1 ,LB2 ,LB3 ,
532 8 LB4 ,LC1 ,LC2 ,LC3 ,LC4 ,
533 9 P1 ,P2 ,P3 ,P4 ,FCONT ,
534 B IX1 ,IX2 ,IX3 ,IX4 ,NSVG ,
535 C IVIS2 ,NELTST ,ITYPTST ,DT2T ,
536 D GAPV ,INACTI ,INDEX2(NFT+1),NISKYFI ,
537 E KINET ,NEWFRONT ,ISECIN ,NSTRF ,SECFCUM ,
538 F X ,INTBUF_TAB%XA,CE_LOC ,MFROT ,IFQ ,
539 G INTBUF_TAB%FRIC_P,INTBUF_TAB%CAND_FX,INTBUF_TAB%CAND_FY,INTBUF_TAB%CAND_FZ,
540 + INTBUF_TAB%XFILTR,
541 H INTBUF_TAB%IFPEN,GAPR,INTBUF_TAB%AVX_ANCR ,NLN ,INTBUF_TAB%NLG,
542 I IBAG ,ICONTACT ,INTBUF_TAB%NSV,INTBUF_TAB%PENIS,
543 + INTBUF_TAB%PENIM,
544 J VISCN ,VXI ,VYI ,VZI ,MSI ,
545 K KINI ,NIN ,NISUB ,INTBUF_TAB%LISUB,INTBUF_TAB%ADDSUBS,
546 L INTBUF_TAB%ADDSUBM,INTBUF_TAB%LISUBS,INTBUF_TAB%LISUBM,FSAVSUB,INTBUF_TAB%CAND_N,
547 M IPARI(33) ,IPARI(39) ,INTBUF_TAB%NODNORM_NORMAL ,FNCONT ,FTCONT ,
548 N X1 ,X2 ,X3 ,X4 ,Y1 ,
549 O Y2 ,Y3 ,Y4 ,Z1 ,Z2 ,
550 P Z3 ,Z4 ,XI ,YI ,ZI ,
551 Q IADM ,RCURVI ,RCONTACT ,ACONTACT ,PCONTACT ,
552 R ANGLMI ,PADM ,INTTH , PHI , FTHE ,
553 S FTHESKYI ,INTBUF_TAB%DAANC6,TEMP ,TEMPI ,RSTIF ,
554 T IFORM ,INTBUF_TAB%GAP_S,IGAP ,INTBUF_TAB%ALPHAK,MSKYI_SMS,
555 U ISKYI_SMS ,NSMS ,CMAJ ,JTASK ,ISENSINT ,
556 V FSAVPARIT ,NFT ,H3D_DATA )
557C
558 ENDIF
559.AND. IF (IMONM > 0 JTASK == 1) CALL STOPTIME(TIMERS,20)
560
561C
562 IF(IMPL_S0 == 1) THEN
563 DO I = 1 ,JLT_NEW
564 NS_IMP(I+NUM_IMP)=CN_LOC(I)
565 NE_IMP(I+NUM_IMP)=CE_LOC(I)
566 IND_IMP(I+NUM_IMP)=INDEX2(I+NFT)
567 ENDDO
568 NUM_IMP=NUM_IMP+JLT_NEW
569 ENDIF
570C
571 ENDDO
572c
573 IF (SFSAVPARIT /= 0)THEN
574 CALL SUM_6_FLOAT_SENS(FSAVPARIT, NISUB+1, 11, I_STOK,1,I_STOK,
575 . FBSAV6, 12, 6, DIMFB, ISENSINT )
576 ENDIF
577 IF(ALLOCATED(FSAVPARIT)) DEALLOCATE (FSAVPARIT)
578C----------------------------------------------------------------------
579C 2- EDGES
580C----------------------------------------------------------------------
581 NLINSA =IPARI(53)
582 IF(NLINSA /= 0)THEN
583 I_STOK = INTBUF_TAB%I_STOK_E(1)
584C this part is performed in parallel after the calculation of element forces
585C static decoupage
586 NB_LOC = I_STOK / NTHREAD
587 IF (JTASK==NTHREAD) THEN
588 I_STOK_LOC = I_STOK-NB_LOC*(NTHREAD-1)
589 ELSE
590 I_STOK_LOC = NB_LOC
591 ENDIF
592 DEBUT = (JTASK-1)*NB_LOC
593 I_STOK = 0
594C recalculation of istok
595 DO I = DEBUT+1, DEBUT+I_STOK_LOC
596 IF(INTBUF_TAB%LCAND_S(I) < 0) THEN
597 I_STOK = I_STOK + 1
598 INDEX2(I_STOK) = I
599C inbuf == cand_S
600 INTBUF_TAB%LCAND_S(I) = -INTBUF_TAB%LCAND_S(I)
601 ENDIF
602 ENDDO
603 IF (DEBUG(3)>=1) THEN
604 NB_JLT = NB_JLT + I_STOK_LOC
605 NB_STOK_N = NB_STOK_N + I_STOK
606 ENDIF
607C
608 SFSAVPARIT = 0
609 DO I=1,NISUB+1
610 IF(ISENSINT(I)/=0) THEN
611 SFSAVPARIT = SFSAVPARIT + 1
612 ENDIF
613 ENDDO
614 IF (SFSAVPARIT /= 0) THEN
615 ALLOCATE(FSAVPARIT(NISUB+1,11,I_STOK),STAT=IERROR)
616 IF(IERROR/=0) THEN
617 CALL ANCMSG(MSGID=19,ANMODE=ANINFO,
618 . C1='(/INTER/TYPE20)')
619 CALL ARRET(2)
620 ENDIF
621 DO J=1,I_STOK
622 DO I=1,11
623 DO H=1,NISUB+1
624 FSAVPARIT(H,I,J) = ZERO
625 ENDDO
626 ENDDO
627 ENDDO
628 ELSE
629 ALLOCATE(FSAVPARIT(0,0,0),STAT=IERROR)
630 IF(IERROR/=0) THEN
631 CALL ANCMSG(MSGID=19,ANMODE=ANINFO,
632 . C1='(/INTER/TYPE20)')
633 CALL ARRET(2)
634 ENDIF
635 ENDIF
636C
637 DO NFT = 0 , I_STOK - 1 , NVSIZ
638 JLT = MIN( NVSIZ, I_STOK - NFT )
639C preparation CANDIDATES retenus
640 CALL I11CDCOR3(
641 1 JLT,INDEX2(NFT+1),INTBUF_TAB%LCAND_N,INTBUF_TAB%LCAND_S,CM_LOC,
642 2 CS_LOC)
643 CALL I20COR3E(
644 1 JLT ,INTBUF_TAB%IXLINS,INTBUF_TAB%IXLINM,INTBUF_TAB%XA,INTBUF_TAB%VA,
645 2 CS_LOC ,CM_LOC ,INTBUF_TAB%STFS,INTBUF_TAB%STF,GAPMIN ,
646 3 INTBUF_TAB%GAP_SE,INTBUF_TAB%GAP_ME,IGAP ,GAPV ,MS ,
647 4 STIF ,XXS1 ,XXS2 ,XYS1 ,XYS2 ,
648 5 XZS1 ,XZS2 ,XXM1 ,XXM2 ,XYM1 ,
649 6 XYM2 ,XZM1 ,XZM2 ,VXS1 ,VXS2 ,
650 7 VYS1 ,VYS2 ,VZS1 ,VZS2 ,VXM1 ,
651 8 VXM2 ,VYM1 ,VYM2 ,VZM1 ,VZM2 ,
652 9 MS1 ,MS2 ,MM1 ,MM2 ,N1 ,
653 A N2 ,M1 ,M2 ,NLINSA ,NIN ,
654 B NL1 ,NL2 ,ML1 ,ML2 ,INTBUF_TAB%NLG,
655 C INTBUF_TAB%STFAC,NODNX_SMS ,NSMS )
656
657 CALL I20DST3E(
658 1 JLT ,CS_LOC,CM_LOC ,HS1 ,HS2 ,
659 2 HM1 ,HM2 ,NX ,NY ,NZ ,
660 3 STIF ,N1 ,N2 ,M1 ,M2 ,
661 4 JLT_NEW,XXS1 ,XXS2 ,XYS1 ,XYS2 ,
662 5 XZS1 ,XZS2 ,XXM1 ,XXM2 ,XYM1 ,
663 6 XYM2 ,XZM1 ,XZM2 ,VXS1 ,VXS2 ,
664 7 VYS1 ,VYS2 ,VZS1 ,VZS2 ,VXM1 ,
665 8 VXM2 ,VYM1 ,VYM2 ,VZM1 ,VZM2 ,
666 9 MS1 ,MS2 ,MM1 ,MM2 ,GAPV ,
667 A NL1 ,NL2 ,ML1 ,ML2 ,IGAP ,
668 B INTBUF_TAB%SOLIDN_NORMAL,INTBUF_TAB%GAP_SE,INTBUF_TAB%GAP_ME,NLINSA,
669 C INTBUF_TAB%SOLIDN_NORMAL_FE,NSMS)
670 JLT = JLT_NEW
671.AND. IF (IMONM > 0 JTASK == 1) CALL STARTIME(TIMERS,20)
672 IF(JLT_NEW/=0) THEN
673 IPARI(29) = 1
674 IF (DEBUG(3)>=1)
675 . NB_JLT_NEW = NB_JLT_NEW + JLT_NEW
676 CALL I20FOR3E(
677 1 JLT ,A ,V ,IBC ,ICODT ,
678 2 FSAV ,GAP ,FRIC ,MS ,VISC ,
679 3 VISCF ,NOINT ,ITAB ,CS_LOC ,CM_LOC ,
680 4 STIGLO ,STIFN ,STIF ,FSKYI ,ISKY ,
681 5 FCONT ,INTBUF_TAB%STFS,INTBUF_TAB%STF,DT2T ,HS1 ,
682 6 HS2 ,HM1 ,HM2 ,N1 ,N2 ,
683 7 M1 ,M2 ,IVIS2 ,NELTST ,ITYPTST ,
684 8 NX ,NY ,NZ ,GAPV ,INTBUF_TAB%PENISE,
685 9 INTBUF_TAB%PENIME,IPARI(22) ,NISKYFIE ,NEWFRONT ,ISECIN ,
686 A NSTRF ,SECFCUM ,VISCN ,NLINSA ,MS1 ,
687 B MS2 ,MM1 ,MM2 ,VXS1 ,VYS1 ,
688 C VZS1 ,VXS2 ,VYS2 ,VZS2 ,VXM1 ,
689 D VYM1 ,VZM1 ,VXM2 ,VYM2 ,VZM2 ,
690 E NIN ,NL1 ,NL2 ,ML1 ,ML2 ,
691 F INTBUF_TAB%DAANC6,INTBUF_TAB%ALPHAK,MSKYI_SMS ,ISKYI_SMS ,NSMS,
692 G JTASK ,ISENSINT ,FSAVPARIT ,NISUB ,NFT ,
693 H H3D_DATA )
694
695 ENDIF
696.AND. IF (IMONM > 0 JTASK == 1) CALL STOPTIME(TIMERS,20)
697 IF(IMPL_S0==1) THEN
698 DO I = 1 ,JLT_NEW
699 NS_IMP(I+NUM_IMP)=CS_LOC(I)
700 NE_IMP(I+NUM_IMP)=CM_LOC(I)
701 ENDDO
702 NUM_IMP=NUM_IMP+JLT_NEW
703 ENDIF
704 ENDDO
705 IF (SFSAVPARIT /= 0)THEN
706 CALL SUM_6_FLOAT_SENS(FSAVPARIT, NISUB+1, 11, I_STOK,1,I_STOK,
707 . FBSAV6, 12, 6, DIMFB, ISENSINT )
708 ENDIF
709 IF(ALLOCATED(FSAVPARIT)) DEALLOCATE (FSAVPARIT)
710 ENDIF
711
712C----------------------------------------------------------------------
713C 3- Forces between second node.and anchor node
714C----------------------------------------------------------------------
715 CALL MY_BARRIER
716C----------------------------------------------------------------------
717C NODES second,main,edge
718C----------------------------------------------------------------------
719.AND. IF (IMONM > 0 JTASK == 1) CALL STARTIME(TIMERS,20)
720 NLNFT1= (JTASK-1)*NLN/NTHREAD
721 NLNLT = JTASK*NLN/NTHREAD
722 NLNL = NLNLT - NLNFT1
723 CALL I20FOR3C(
724 1 NLNL ,INTBUF_TAB%NLG(1+NLNFT1),MS ,INTBUF_TAB%AVX_ANCR(1+3*NLNFT1),
725 2 INTBUF_TAB%AVX_ANCR(1+3*NLN+3*NLNFT1),INTBUF_TAB%STFA(1+NLNFT1),WEIGHT,INACTI,
726 3 INTBUF_TAB%DAANC6(1+18*2*NLNFT1),INTBUF_TAB%STFAC(1),
727 3 INTBUF_TAB%PENIA(1+5*NLNFT1),INTBUF_TAB%ALPHAK(1+3*NLNFT1),
728 4 INTBUF_TAB%AVX_ANCR(1+6*NLN+3*NLNFT1),KMIN)
729
730.AND. IF (IMONM > 0 JTASK == 1) CALL STOPTIME(TIMERS,20)
731 IF(IGAP/=0)THEN
732 CALL MY_BARRIER
733 IF(JTASK == 1) THEN
734 DEALLOCATE(INTBUF_TAB%SOLIDN_NORMAL)
735 IF(NSPMD > 1) THEN
736 DEALLOCATE(INTBUF_TAB%SOLIDN_NORMAL_F)
737 DEALLOCATE(INTBUF_TAB%SOLIDN_NORMAL_FE)
738 END IF
739 END IF
740 END IF
741.OR. IF(ICURV==3IADM/=0)THEN
742 CALL MY_BARRIER()
743 IF(JTASK == 1)DEALLOCATE(INTBUF_TAB%NODNORM_NORMAL)
744 END IF
745 IF(IADM/=0)THEN
746 CALL MY_BARRIER()
747 IF(JTASK == 1)DEALLOCATE(INTBUF_TAB%MODRCURV,INTBUF_TAB%MODANGLM)
748 END IF
749C-----------
750 RETURN
751 END
i20mainf
subroutine i20mainf(output, timers, ipari, x, a, icodt, fsav, v, ms, dt2t, neltst, ityptst, itab, stifn, fskyi, isky, fcont, nin, lindmax, kinet, jtask, nb_jlt, nb_jlt_new, nb_stok_n, niskyfi, newfront, nstrf, secfcum, icontact, viscn, num_imp, ns_imp, ne_imp, ind_imp, fsavsub, nrtmdim, fsavbag, eminx, ixs, ixs16, ixs20, fncont, ftcont, iad_elem, fr_elem, rcontact, acontact, pcontact, temp, fthe, ftheskyi, pm, iparg, iad17, weight, niskyfie, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, mskyi_sms, iskyi_sms, nodnx_sms, npc, tf, intbuf_tab, fbsav6, isensint, dimfb, h3d_data, theaccfact)
Definition i20mainf.F:81
h3d_mod
Definition h3d_mod.F:311
message_mod
Definition message_mod.F:1257
sum_6_float_sens
subroutine sum_6_float_sens(f, a, b, c, jft, jlt, f6, d, e, g, isensint)
Definition parit.F:540