OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inint3.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!|| inint3 ../starter/source/interfaces/inter3d1/inint3.F
25!||--- called by ------------------------------------------------------
26!|| inintr ../starter/source/interfaces/interf1/inintr.f
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| i11buc_vox1 ../starter/source/interfaces/inter3d1/i11buc1.F
30!|| i11dst3 ../starter/source/interfaces/inter3d1/i11dst3.F
31!|| i11pwr3 ../starter/source/interfaces/inter3d1/i11pwr3.F
32!|| i11remline ../starter/source/interfaces/inter3d1/i11remlin.F
33!|| i11sti3 ../starter/source/interfaces/inter3d1/i11sti3.F
34!|| i12chk3 ../starter/source/interfaces/inter3d1/i12chk3.F
35!|| i12tid3 ../starter/source/interfaces/inter3d1/i12tid3.F
36!|| i17sti3 ../starter/source/interfaces/inter3d1/i17sti3.F
37!|| i18pwr3 ../starter/source/interfaces/inter3d1/i18pwr3.F
38!|| i1bcs_check ../starter/source/interfaces/int01/i1bcs_check.F90
39!|| i1chk3 ../starter/source/interfaces/inter3d1/i1chk3.F
40!|| i1tid3 ../starter/source/interfaces/inter3d1/i1tid3.F
41!|| i20ini3 ../starter/source/interfaces/inter3d1/i20ini3.F
42!|| i21els3 ../starter/source/interfaces/inter3d1/i21els3.F
43!|| i22err3 ../starter/source/interfaces/inter3d1/i22err3.F
44!|| i22sti3 ../starter/source/interfaces/inter3d1/i22sti3.F
45!|| i22tzinf ../starter/source/interfaces/inter3d1/i22tzinf.F
46!|| i23buc1 ../starter/source/interfaces/inter3d1/i23buc3.F
47!|| i23dst3 ../starter/source/interfaces/inter3d1/i23dst3.F
48!|| i23gap3 ../starter/source/interfaces/inter3d1/i23gap3.F
49!|| i23pwr3 ../starter/source/interfaces/inter3d1/i23pwr3.F
50!|| i24buc1 ../starter/source/interfaces/inter3d1/i24buc1.F
51!|| i24cand ../starter/source/interfaces/inter3d1/i24pen3.f
52!|| i24cor3 ../starter/source/interfaces/inter3d1/i24cor3.F
53!|| i24fici_ini ../starter/source/interfaces/inter3d1/i24surfi.F
54!|| i24fics_ini ../starter/source/interfaces/inter3d1/i24surfi.F
55!|| i24ficv_ini ../starter/source/interfaces/inter3d1/i24surfi.F
56!|| i24ini_gap_n ../starter/source/interfaces/inter3d1/i24inisu_nei.F
57!|| i24inisur_nei ../starter/source/interfaces/inter3d1/i24inisu_nei.F
58!|| i24isegpt_ini ../starter/source/interfaces/inter3d1/i24surfi.F
59!|| i24ll_kg ../starter/source/interfaces/inter3d1/i24sti3.F
60!|| i24pen3 ../starter/source/interfaces/inter3d1/i24pen3.F
61!|| i24pwr3 ../starter/source/interfaces/inter3d1/i24pwr3.F
62!|| i24sti3 ../starter/source/interfaces/inter3d1/i24sti3.F
63!|| i25buc_vox1 ../starter/source/interfaces/inter3d1/i25buc_vox1.F
64!|| i25buce_edg ../starter/source/interfaces/inter3d1/i25buce_edg.F
65!|| i25cand ../starter/source/interfaces/inter3d1/i25pwr3.F
66!|| i25cor3 ../starter/source/interfaces/inter3d1/i25cor3.F
67!|| i25cor3_e2s ../starter/source/interfaces/inter3d1/i25cor3_e2s.F
68!|| i25cor3e ../starter/source/interfaces/inter3d1/i25cor3e.f
69!|| i25dst3_e2s ../starter/source/interfaces/inter3d1/i25dst3_e2s.F
70!|| i25ini_gap_n ../starter/source/interfaces/inter3d1/i25neigh.f
71!|| i25neigh ../starter/source/interfaces/inter3d1/i25neigh.f
72!|| i25norm ../starter/source/interfaces/inter3d1/i25norm3.F
73!|| i25pen3 ../starter/source/interfaces/inter3d1/i25pen3.F
74!|| i25pen3e ../starter/source/interfaces/inter3d1/i25pen3e.F
75!|| i25pwr3 ../starter/source/interfaces/inter3d1/i25pwr3.f
76!|| i25pwr3_e2s ../starter/source/interfaces/inter3d1/i25pwr3_e2s.F
77!|| i25pwr3e ../starter/source/interfaces/inter3d1/i25pwr3e.F
78!|| i25remline ../starter/source/interfaces/int25/i25remlin.F
79!|| i25sors ../starter/source/interfaces/inter3d1/i25sors.F
80!|| i25sti3 ../starter/source/interfaces/inter3d1/i25sti3.F
81!|| i25sti_edg ../starter/source/interfaces/inter3d1/i25sti_edg.F
82!|| i2buc1 ../starter/source/interfaces/inter3d1/i2buc1.F
83!|| i2chk3 ../starter/source/interfaces/inter3d1/i2chk3.F
84!|| i2main ../starter/source/interfaces/interf1/i2master.F
85!|| i2surfs ../starter/source/interfaces/inter3d1/i2surfs.F
86!|| i2tid3 ../starter/source/interfaces/inter3d1/i2tid3.F
87!|| i2wcontdd ../starter/source/spmd/domain_decomposition/grid2mat.F
88!|| i3pen3 ../starter/source/interfaces/inter3d1/i3pen3.F
89!|| i3sti3 ../starter/source/interfaces/inter3d1/i3sti3.F
90!|| i5pwr3 ../starter/source/interfaces/inter3d1/i3pen3.F
91!|| i7buc1 ../starter/source/interfaces/inter3d1/i7buc1.F
92!|| i7buc_vox1 ../starter/source/interfaces/inter3d1/i7buc_vox1.F
93!|| i7cor3 ../starter/source/interfaces/inter3d1/i7cor3.F
94!|| i7dst3 ../starter/source/interfaces/inter3d1/i7dst3.F
95!|| i7err3 ../starter/source/interfaces/inter3d1/i7err3.F
96!|| i7pen3 ../starter/source/interfaces/inter3d1/i7pen3.F
97!|| i7pwr3 ../starter/source/interfaces/inter3d1/i7pwr3.F
98!|| i7remnode ../starter/source/interfaces/inter3d1/i7remnode.F
99!|| i7sti3 ../starter/source/interfaces/inter3d1/i7sti3.F
100!|| i9bcs_check ../starter/source/interfaces/int09/i9bcs_check.F90
101!|| i9sti3 ../starter/source/interfaces/int09/i9sti3.F
102!|| in12r ../starter/source/interfaces/inter3d1/in12r.F
103!|| inint0 ../starter/source/interfaces/interf1/inint0.F
104!|| inint0_8 ../starter/source/interfaces/interf1/inint0_8.F
105!|| invoi3 ../starter/source/interfaces/inter3d1/invoi3.F
106!|| ispt2_ini ../starter/source/interfaces/inter3d1/i24surfi.F
107!|| iwcontdd ../starter/source/spmd/domain_decomposition/grid2mat.F
108!|| iwcontdd_151 ../starter/source/spmd/domain_decomposition/grid2mat.F
109!|| iwcontdd_type24 ../starter/source/spmd/domain_decomposition/iwcontdd_type24.F
110!|| iwcontdd_type25 ../starter/source/spmd/domain_decomposition/iwcontdd_type25.F
111!|| remn_i2op ../starter/source/interfaces/inter3d1/i7remnode.F
112!|| update_weight_inter_type11 ../starter/source/spmd/domain_decomposition/update_weight_inter_type11.F
113!|| update_weight_inter_type2 ../starter/source/spmd/domain_decomposition/update_weight_inter_type2.F
114!|| update_weight_inter_type7 ../starter/source/spmd/domain_decomposition/update_weight_inter_type7.F
115!|| update_weight_inter_type_24_25 ../starter/source/spmd/domain_decomposition/update_weight_inter_type_24_25.F
116!|| upgrade_ixint ../starter/source/interfaces/interf1/upgrade_ixint.F
117!|| upgrade_remnode ../starter/source/interfaces/interf1/upgrade_remnode.F
118!|| upgrade_remnode_edg ../starter/source/interfaces/interf1/upgrade_remnode.F
119!||--- uses -----------------------------------------------------
120!|| front_mod ../starter/share/modules1/front_mod.F
121!|| i1bcs_check_mod ../starter/source/interfaces/int01/i1bcs_check.F90
122!|| i9bcs_check_mod ../starter/source/interfaces/int09/i9bcs_check.F90
123!|| inter_cand_mod ../starter/share/modules1/inter_cand_mod.F
124!|| message_mod ../starter/share/message_module/message_mod.F
125!|| stack_mod ../starter/share/modules1/stack_mod.F
126!||====================================================================
127 SUBROUTINE inint3(INSCR ,X ,IXS ,IXC ,PM ,
128 1 GEO ,IPARI ,NIN ,ITAB ,MS ,
129 2 MWA ,RWA ,IXTG ,IWRN ,IKINE ,
130 3 IXT ,IXP ,IXR ,NELEMINT ,IDDLEVEL,
131 4 IFIEND ,ALE_CONNECTIVITY ,NSNET ,NMNET ,IGRBRIC ,
132 5 IWCONT ,NSNT ,NMNT ,NSN2T ,NMN2T ,
133 6 IWCIN2 ,KNOD2ELS ,KNOD2ELC ,KNOD2ELTG ,NOD2ELS ,
134 7 NOD2ELC ,NOD2ELTG ,IGRSURF ,IKINE1 ,IELEM21 ,
135 8 SH4TREE ,SH3TREE ,IPART ,IPARTC ,IPARTTG ,
136 9 THK ,THK_PART ,NOD2EL1D ,KNOD2EL1D ,IXS10 ,
137 A I_MEM ,RESORT ,INTER_CAND ,IXS16 ,IXS20 ,
138 B ID ,TITR ,IREMNODE ,NREMNODE ,IPARTS ,
139 C KXX ,IXX ,IGEO ,INTERCEP ,LELX ,
140 D INTBUF_TAB ,FILLSOL ,stack ,IWORKSH ,KXIG3D ,
141 E IXIG3D ,TAGPRT_FRIC ,INTBUF_FRIC_TAB ,IPARTT ,IPARTP ,
142 F IPARTX ,IPARTR ,NSN_MULTI_CONNEC ,T2_ADD_CONNEC,T2_NB_CONNEC,
143 G T2_CONNEC ,NOM_OPT ,ICODE ,ISKEW ,IREMNODE_EDG,
144 H S_APPEND_ARRAY,X_APPEND ,MASS_APPEND ,N2D ,FLAG_REMOVED_NODE,
145 I NSPMD ,INTER_TYPE2_NUMBER ,ELEM_LINKED_TO_SEGMENT,SINSCR ,SICODE ,
146 J SITAB ,NIN25 ,FLAG_ELEM_INTER25 ,MULTI_FVM ,IRESP )
147C-----------------------------------------------
148C D e s c r i p t i o n
149C-----------------------------------------------
150C Interfaces initialization for 3D analysis (N2D=0)
151C-----------------------------------------------
152C M o d u l e s
153C-----------------------------------------------
154 USE message_mod
155 USE my_alloc_mod
156 USE shrink_array_mod
157 USE front_mod
158 USE intbufdef_mod
159 USE intbuf_fric_mod
160 USE groupdef_mod
161 USE ale_connectivity_mod
162 USE inter_cand_mod
163 USE names_and_titles_mod , ONLY : nchartitle
164 USE multi_fvm_mod , ONLY : multi_fvm_struct
165 use i9bcs_check_mod , ONLY : i9bcs_check
166 use i1bcs_check_mod , only : i1bcs_check
167 use stack_mod , only : stack_ply
168 use element_mod , only :nixs,nixc,nixtg,nixt,nixp,nixr
169C-----------------------------------------------
170C I m p l i c i t T y p e s
171C-----------------------------------------------
172#include "implicit_f.inc"
173C-----------------------------------------------
174C G l o b a l P a r a m e t e r s
175C-----------------------------------------------
176#include "mvsiz_p.inc"
177C-----------------------------------------------
178C C o m m o n B l o c k s
179C-----------------------------------------------
180#include "com04_c.inc"
181#include "param_c.inc"
182#include "scr03_c.inc"
183#include "scr12_c.inc"
184#include "units_c.inc"
185#include "vect07_c.inc"
186#include "scr17_c.inc"
187C-----------------------------------------------
188C D u m m y A r g u m e n t s
189C-----------------------------------------------
190 TYPE(multi_fvm_struct),INTENT(IN) :: MULTI_FVM
191 INTEGER,INTENT(IN) :: SITAB !< array sizes
192 INTEGER,INTENT(IN) :: SICODE !< array size ICODE
193 INTEGER,INTENT(IN) :: ICODE(SICODE) !< boundary condition code for each node
194 INTEGER,INTENT(IN) :: SINSCR !< array size
195 INTEGER NIN, IWRN, NSNT, NMNT, NSN2T, NMN2T, NSNET ,NMNET ,RESORT
196 INTEGER, INTENT(in) :: N2D !< flag for 2D/3D, 0-->3D, 1-->2D
197 INTEGER, DIMENSION(NPARI,NINTER), INTENT(inout) :: IPARI !< interface data
198 INTEGER INSCR(SINSCR), IXS(NIXS,NUMELS), IXC(NIXC,NUMELC),
199 . IXT(NIXT,NUMELT) ,IXP(NIXP,NUMELP) ,IXR(NIXR,NUMELR),
200 . ITAB(SITAB), MWA(*), IXTG(NIXTG,NUMELTG), IKINE(*),
201 . NELEMINT, IDDLEVEL,IFIEND,
202 . IWCONT(*), IWCIN2(*),
203 . KNOD2ELS(*), KNOD2ELC(*), KNOD2ELTG(*),
204 . NOD2ELS(*), NOD2ELC(*), NOD2ELTG(*),
205 . SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*), IPART(*),
206 . IPARTC(*), IPARTTG(*),NOD2EL1D(*),KNOD2EL1D(*),
207 . IXS10(6,*), IXS16(8,*), IXS20(12,*), IPARTS(*),
208 . KXIG3D(NIXIG3D,*),IXIG3D(*),TAGPRT_FRIC(*),
209 . ipartt(*) ,ipartp(*) ,ipartx(*) ,ipartr(*),
210 . iskew(*)
211 INTEGER IKINE1(*), IELEM21(*),I_MEM,ID,IREMNODE,IREMNODE_EDG,
212 . nremnode,kxx(*),ixx(*),igeo(*),iworksh(*),nsn_multi_connec,t2_add_connec(*),
213 . t2_nb_connec(*),t2_connec(*)
214 INTEGER NOM_OPT(LNOPT1,*)
215 INTEGER, INTENT(in) :: NSPMD !< number of mpi tasks
216 INTEGER, INTENT(in) :: INTER_TYPE2_NUMBER !<number of interface type 2
217 my_real
218 . pm(*), geo(*), rwa(6,*),
219 . thk(*),thk_part(*), lelx(*), fillsol(*)
220 my_real, TARGET :: ms(numnod)
221 my_real, TARGET :: x(3*numnod)
222 INTEGER, INTENT(in) :: S_APPEND_ARRAY !< size of X/MASS _APPEND
223 my_real, DIMENSION(3*S_APPEND_ARRAY), TARGET :: X_APPEND !< extended position array for interface 18 + law 151
224 my_real, DIMENSION(S_APPEND_ARRAY), TARGET :: MASS_APPEND !< extended mass array for interface 18 + law 151
225 INTEGER , INTENT(IN) :: IRESP
226 CHARACTER(LEN=NCHARTITLE)::TITR
227 TYPE(INTERSURFP) :: INTERCEP(3,NINTER)
228 TYPE(INTBUF_STRUCT_), DIMENSION(NINTER), INTENT(inout) :: INTBUF_TAB !< interface data
229 TYPE(INTBUF_FRIC_STRUCT_) INTBUF_FRIC_TAB(*)
230C-----------------------------------------------
231 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
232 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
233 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
234 LOGICAL, INTENT(in) :: FLAG_REMOVED_NODE !< flag to remove some S node from the list of candidates
235 TYPE(inter_cand_), iNTENT(inout) :: INTER_CAND
236 INTEGER, DIMENSION(NUMELS), INTENT(INOUT):: ELEM_LINKED_TO_SEGMENT
237 INTEGER, INTENT(IN) :: NIN25
238 INTEGER, INTENT(IN) :: FLAG_ELEM_INTER25(NINTER25,NUMELS)
239 type(stack_ply), intent(inout) :: stack !< stack data structure
240C-----------------------------------------------
241C L o c a l V a r i a b l e s
242C-----------------------------------------------
243 INTEGER NRTS, NRTM, NSN, NMN, NMN0, NTY, NST, NMT, IBUC, NOINT,
244 . nsne, nmne,nlins,nlinm,nln,l16,l17,l20,l21,l22,l23,j31p,j36p,
245 . i, i_stok,irs,irm,ilev,idel2,iproj,
246 . nseg, ngrous, ng, inacti,iwpene,istok,
247 . jlt_new,igap,multimp,inpene,isearch,itied,
248 . ign,ige,nme,nmes,nad,ead,isu1,isu2,l30,
249 . intth, ibidon,nlinsa,nlinma,iss2,ifs2,isym,ignore,ncont,icurv,
250 . dimflag,ipen0,intkg,intply,nrtse,nsn0,ith, nadmsr, nedge, ierror, it19,int_typ,
251 . nrtm_fe, nrtm_ige,nmn_ige,nmn_fe,nrts_fe, nrts_ige,nsn_ige,nsn_fe,l,iedg4,is1,
252 . ivis2, isharp, iedge, inactbid, ithk25, igap0,igsti
253 INTEGER :: NUMNOD_P ! fake numnod for interface type 7, NUMNOD_P can be = to NUMNOD or NUMNOD+NUMELS
254 integer
255 . n1(mvsiz),n2(mvsiz),m1(4,mvsiz),m2(4,mvsiz),nrtm0,nrtm_sh,iwpene0,iad,nbric,grbric_id,ii,ibric,iad_ixint,
256 . nodeid, inod, mvoisn(mvsiz,4),ibound(4,mvsiz)
257 INTEGER ITASK, NEDGE_T, ESHIFT, NRTM_T, SSHIFT, MULNSNE, MULNSNS, MULTIMPE, MULTIMPS, NCONTE,
258 . cand_e_old(2), i_meme(2),
259 . i_start, i_mem_rem, new_size
260 INTEGER :: KIND_INTER
261 my_real MARGE,VMAXDT, BMINMA(6), GAPM_MX, GAPS_MX, GAPM_L_MX,GAPS_L_MX
262 my_real maxbox,minbox,gap0,bid,tzinf,gapinf,bidon,fpenmax,drad,penmn,gapscale,bgapemx_l
263 my_real nx(mvsiz),ny(mvsiz),nz(mvsiz),gapv(mvsiz)
264 my_real rdum(1) ,pene_max,penmax,facf
265 my_real :: gap,gapmin,gapmax,dgapload
266 my_real, DIMENSION(:),ALLOCATABLE :: penmin,gap_maxneigh
267 INTEGER, DIMENSION(:),ALLOCATABLE :: IPARTNS,INOD2LIN,TAGSECND,NOD2LIN,PERM,PERMINV
268 my_real, DIMENSION(:),ALLOCATABLE, TARGET :: XE
269 my_real, DIMENSION(:),POINTER :: PTR_X,PTR_MS
270 INTEGER, POINTER :: pIXINT
271 INTEGER, DIMENSION(:),ALLOCATABLE :: IPARTSM
272C-----------------------------------------------
273 INTEGER, DIMENSION(MVSIZ) ::PROV_N,PROV_E
274 INTEGER, DIMENSION(MVSIZ) :: IX1,IX2,IX3,IX4,NSVG
275 my_real, DIMENSION(MVSIZ) :: X1,X2,X3,X4
276 my_real, DIMENSION(MVSIZ) :: y1,y2,y3,y4
277 my_real, DIMENSION(MVSIZ) :: z1,z2,z3,z4
278 my_real, DIMENSION(MVSIZ) :: xi,yi,zi
279 my_real, DIMENSION(MVSIZ) :: x0,y0,z0,stif
280 my_real, DIMENSION(MVSIZ) :: n11,n21,n31
281 my_real, DIMENSION(MVSIZ) :: xn1,yn1,zn1
282 my_real, DIMENSION(MVSIZ) :: xn2,yn2,zn2
283 my_real, DIMENSION(MVSIZ) :: xn3,yn3,zn3
284 my_real, DIMENSION(MVSIZ) :: xn4,yn4,zn4
285 my_real, DIMENSION(MVSIZ) :: p1,p2,p3,p4
286 my_real, DIMENSION(MVSIZ) :: lb1,lb2,lb3,lb4
287 my_real, DIMENSION(MVSIZ) :: lc1,lc2,lc3,lc4
288 my_real, DIMENSION(MVSIZ) :: s,t
289 my_real
290 . nnx(mvsiz,5), nny(mvsiz,5), nnz(mvsiz,5), pene(4,mvsiz), ! Dimension 4 is needed for i25dst3_e2s
291 . gaps(mvsiz), gapm(mvsiz), gap_nm(4,mvsiz), gapmxl(mvsiz),
292 . xxs1(mvsiz), xxs2(mvsiz), xys1(mvsiz), xys2(mvsiz), xzs1(mvsiz), xzs2(mvsiz),
293 . xxm1(4,mvsiz), xxm2(4,mvsiz), xym1(4,mvsiz), xym2(4,mvsiz), xzm1(4,mvsiz), xzm2(4,mvsiz),
294 . gapve(mvsiz),
295 . ex(4,mvsiz), ey(4,mvsiz), ez(4,mvsiz), fx(mvsiz), fy(mvsiz), fz(mvsiz)
296 LOGICAL PRINT_WARNING,LAW151_TYPE18,TYPE18
297 CHARACTER FILNAM*100
298 INTEGER :: TOTAL_NUMBER_CANDIDATE
299 INTEGER :: SKIP_TYPE25_EDGE_2_EDGE !< flag for interface 25 :( : if edge to edge is used by interface type 25, need to do the computation after the initialization of LEDGE array | (0) no interface 25 with e2e --> nodes can be removed, (1) interface 25 with e2e --> other interfaces can be treated, (2) only the interface type 25 with e2e is treated
300 INTEGER :: FLAG_OUTPUT
301 INTEGER, DIMENSION(NINTER) :: NREMN
302 LOGICAL :: LOCAL_FLAG_REMOVED_NODE
303 INTEGER :: NN, NNI,ijk
304 LOGICAL :: IS_USED_WITH_LAW151
305C=======================================================================
306 inpene = 0
307 iwpene = 0
308 istok = 0
309 nrts = ipari(3,nin)
310 nrtm = ipari(4,nin)
311 nsn = ipari(5,nin)
312 nmn = ipari(6,nin)
313 nmn0 = nmn
314 nty = ipari(7,nin)
315 nst = ipari(8,nin)
316 nmt = ipari(9,nin)
317 ibuc = ipari(12,nin)
318 isearch = ipari(12,nin)
319 noint = ipari(15,nin)
320 igap = ipari(21,nin)
321 inacti = ipari(22,nin)
322 multimp = ipari(23,nin)
323 irm = ipari(24,nin)
324 irs = ipari(25,nin)
325 idel2 = ipari(17,nin)
326 ilev = ipari(20,nin)
327 itied = 0
328 isu1 = ipari(45,nin)
329 isu2 = ipari(46,nin)
330 intth = ipari(47,nin)
331 nrtm_sh = ipari(42,nin)
332 ncont = ipari(18,nin)
333 icurv = ipari(39,nin)
334 intkg = ipari(65,nin)
335 intply = ipari(66,nin)
336 it19 = ipari(71,nin)
337 drad = zero
338 rdum(1) = 0
339 nrtm_ige = ipari(73,nin)
340 nrtm_fe = ipari(74,nin)
341 nrts_ige = ipari(75,nin)
342 nrts_fe = ipari(76,nin)
343 nsn_ige = ipari(77,nin)
344 nsn_fe = ipari(78,nin)
345 nmn_ige = ipari(79,nin)
346 nmn_fe = ipari(80,nin)
347 igap0 = ipari(53,nin)
348 iedge = ipari(58,nin)
349 nconte = ipari(88,nin)
350 is1 = ipari(13,nin) / 10
351
352 law151_type18=.false.
353 type18=.false.
354 IF(nty==7 .AND. inacti==7) type18=.true.
355 IF(type18.AND.ipari(14,nin)==151)law151_type18=.true.
356 IF (it19<=0) THEN
357 int_typ = max(nty,abs(it19)*19)
358 IF (resort == 0)THEN
359 IF((nty==7.AND.inacti==7).AND.(nty/=22))THEN
360 WRITE(iout,2181)noint
361 ELSE
362 WRITE(iout,2001)noint,int_typ
363 END IF
364 END IF
365 ENDIF
366C-----------------------------------------------------------------------
367 IF(nty==1) THEN
368C-----------------------------------------------------------------------
369 l17=1
370 l20=l17+nmn
371 l22=l20+1+nsn
372
373 !must be flushed to 0 (in old code INBUF and BUFIN
374 !flushed between 2 domain decomposition (otherwise ININT0 subroutine does not store the expected segments)
375 intbuf_tab(nin)%NRT(1:nmt) = 0
376C
377 CALL inint0(
378 1 x ,intbuf_tab(nin)%IRECTM ,intbuf_tab(nin)%NSEGM ,intbuf_tab(nin)%NRT ,intbuf_tab(nin)%MSR,
379 2 intbuf_tab(nin)%NSV ,intbuf_tab(nin)%ILOCS ,nsn ,nmn ,nrtm ,intbuf_tab(nin)%S_IRECTM,
380 3 intbuf_tab(nin)%S_NRT )
381 CALL i1chk3(
382 1 x ,intbuf_tab(nin)%IRECTS ,ixs ,nrts ,ixc ,
383 2 nin ,nsn ,intbuf_tab(nin)%NSV ,noint ,ixtg ,
384 3 geo ,pm ,knod2els ,knod2elc ,knod2eltg ,
385 4 nod2els , nod2elc ,nod2eltg ,igrsurf(isu1) ,
386 5 thk ,nty ,ixs10 ,ixs16 ,ixs20 ,
387 6 id ,titr ,igeo ,stack%pm ,iworksh )
388 CALL i1chk3(
389 1 x ,intbuf_tab(nin)%IRECTM ,ixs ,nrtm ,ixc ,
390 2 -nin ,nmn ,intbuf_tab(nin)%MSR ,noint ,ixtg,
391 3 geo ,pm ,knod2els ,knod2elc ,knod2eltg ,
392 4 nod2els , nod2elc ,nod2eltg ,igrsurf(isu2) ,
393 5 thk ,nty ,ixs10 ,ixs16 ,ixs20 ,
394 6 id ,titr , igeo ,stack%pm ,iworksh)
395 CALL invoi3(
396 1 x ,intbuf_tab(nin)%IRECTM ,intbuf_tab(nin)%NRT ,intbuf_tab(nin)%MSR ,intbuf_tab(nin)%NSV,
397 2 intbuf_tab(nin)%ILOCS ,intbuf_tab(nin)%IRTLM ,intbuf_tab(nin)%NSEGM ,nsn ,nmn ,
398 3 itab ,id ,titr ,nrtm)
399 WRITE(iout,2002)
400C
401 CALL i1tid3(
402 1 x ,intbuf_tab(nin)%IRECTM ,intbuf_tab(nin)%CSTS ,intbuf_tab(nin)%MSR ,intbuf_tab(nin)%NSV,
403 2 intbuf_tab(nin)%ILOCS ,intbuf_tab(nin)%IRTLM ,nsn ,itab ,ikine ,
404 3 ikine1 ,id ,titr ,ilev ,nty ,
405 4 intbuf_tab(nin)%CSTS_BIS)
406 CALL i1bcs_check(icode, sicode, nsn, intbuf_tab(nin)%NSV, sitab, itab, noint, titr, nty)
407C-----------------------------------------------------------------------
408 ELSEIF(nty == 2 .AND. isearch == 1) THEN
409C-----------------------------------------------------------------------
410 l16 = 1
411 l17 = l16+nsn
412 l20 = l17+nmn
413 l21 = l20+1+nsn
414 l22 = l21+1+nmn
415 l23 = l22+nst
416 CALL inint0(
417 1 x ,intbuf_tab(nin)%IRECTM ,inscr(l21) ,inscr(l23) ,intbuf_tab(nin)%MSR,
418 2 intbuf_tab(nin)%NSV ,inscr(l16) ,nsn ,nmn ,nrtm ,intbuf_tab(nin)%S_IRECTM,
419 3 sinscr-l23+1 )
420
421 IF (ipari(13,nin)>0) THEN ! check for s/s input is done before
422 CALL i1chk3(
423 1 x ,intbuf_tab(nin)%IRECTM ,ixs ,nrtm ,ixc ,
424 2 -nin ,nmn ,intbuf_tab(nin)%MSR ,noint ,ixtg ,
425 3 geo ,pm ,knod2els ,knod2elc ,knod2eltg ,
426 4 nod2els ,nod2elc ,nod2eltg ,igrsurf(isu2) ,
427 5 thk ,nty ,ixs10 ,ixs16 ,ixs20 ,
428 6 id ,titr ,igeo ,stack%pm ,iworksh )
429 END IF
430 CALL invoi3(
431 1 x ,intbuf_tab(nin)%IRECTM ,inscr(l23) ,intbuf_tab(nin)%MSR ,intbuf_tab(nin)%NSV,
432 2 inscr(l16) ,intbuf_tab(nin)%IRTLM ,inscr(l21) ,nsn ,nmn ,
433 3 itab ,id ,titr ,nrtm)
434 WRITE(iout,2002)
435 CALL i1tid3(
436 1 x ,intbuf_tab(nin)%IRECTM ,intbuf_tab(nin)%CSTS ,intbuf_tab(nin)%MSR ,intbuf_tab(nin)%NSV,
437 2 inscr(l16) ,intbuf_tab(nin)%IRTLM ,nsn ,itab ,ikine ,
438 3 ikine1 ,id ,titr ,ilev ,nty ,
439 4 intbuf_tab(nin)%CSTS_BIS)
440C selecting relevant main nodes et recompating the interface buffer
441C Warning : NMN et K14 updated by I2MAIN
442 CALL i2main(intbuf_tab(nin)%NSV,intbuf_tab(nin)%MSR,intbuf_tab(nin)%IRECTM,ipari(1,nin),
443 . mwa,mwa(numnod+1),intbuf_tab(nin))
444C
445 nmn = ipari(6,nin)
446 intth = ipari(47,nin)
447 IF ((ilev==20 .OR. ilev==21 .OR. ilev==22) .OR. intth > 0 ) THEN
448 j31p =1+2*(nmn0-nmn)
449 j36p =1+2*(nmn0-nmn)
450 DO i = 1,nsn
451 intbuf_tab(nin)%AREAS2(i) = intbuf_tab(nin)%AREAS2(j31p+i-1)
452 ENDDO
453 CALL i2surfs(
454 . x ,intbuf_tab(nin)%NSV ,intbuf_tab(nin)%AREAS2,nsn ,itab ,
455 . ixc ,ixtg ,ixs ,knod2els ,nod2els ,
456 . knod2elc ,nod2elc ,knod2eltg ,nod2eltg ,ilev ,
457 . id ,titr )
458 ENDIF
459 IF ((ilev >=10 .AND. ilev < 23) ) THEN
460 IF (ilev==20 .OR. ilev==21 .OR. ilev==22) THEN
461 j31p =1+2*(nmn0-nmn)
462 j36p =1+2*(nmn0-nmn)
463 intbuf_tab(nin)%RUPT(1) = intbuf_tab(nin)%IRECTM(j36p)
464 intbuf_tab(nin)%RUPT(2) = intbuf_tab(nin)%IRECTM(j36p+1)
465 intbuf_tab(nin)%RUPT(3) = intbuf_tab(nin)%IRECTM(j36p+2)
466 intbuf_tab(nin)%RUPT(4) = intbuf_tab(nin)%IRECTM(j36p+3)
467 intbuf_tab(nin)%RUPT(5) = intbuf_tab(nin)%IRECTM(j36p+4)
468 intbuf_tab(nin)%RUPT(6) = intbuf_tab(nin)%IRECTM(j36p+5)
469 ENDIF
470
471 ENDIF
472
473 ! -----------------
474 ! update the weight of candidate's pair for the domain decomposition
475 IF (iddlevel==0)THEN
476 IF ( ((nelemint+nsn)) > inter_cand%S_IXINT_2) CALL upgrade_ixint(inter_cand,nelemint,nsn)
477 CALL update_weight_inter_type2(nelemint,nin,nsn,nrtm,ifiend,
478 1 n2d,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,intbuf_tab(nin)%IRTLM,inter_cand)
479 ENDIF
480 ! -----------------
481 IF((iddlevel==0).AND.
482 + (dectyp>=3.AND.dectyp<=6))THEN
483C nodal weights and interfaces
484 CALL i2wcontdd(intbuf_tab(nin)%NSV,intbuf_tab(nin)%MSR,nsn,nmn,iwcin2,
485 2 nsn2t ,nmn2t )
486 END IF
487C
488C-----------------------------------------------------------------------
489 ELSEIF(nty==2.AND.isearch==2) THEN
490C-----------------------------------------------------------------------
491 tzinf=intbuf_tab(nin)%VARIABLES(4)
492C j21 has a temporary usage in i2chk3, i2buc3 and i2tied3
493C
494 IF (ipari(13,nin)>0) THEN ! check for s/s input is done before
495 CALL i2chk3(
496 1 x ,intbuf_tab(nin)%IRECTM ,ixs ,nrtm ,ixc ,
497 2 -nin ,nsn ,intbuf_tab(nin)%MSR ,noint ,
498 3 ixtg ,intbuf_tab(nin)%IRTLM ,intbuf_tab(nin)%CSTS ,intbuf_tab(nin)%DPARA ,geo ,
499 4 pm ,knod2els ,knod2elc ,knod2eltg ,nod2els ,
500 5 nod2elc ,nod2eltg ,igrsurf(isu2) ,thk ,
501 6 nty ,ixs10 ,ixs16 ,ixs20 ,igeo ,
502 7 stack%pm ,iworksh )
503 END IF
504C
505C STILL ONE BUCKET SORT
506C
507 ignore = ipari(34,nin)
508 iproj = ipari(57,nin)
509 CALL i2buc1(
510 1 x ,intbuf_tab(nin)%IRECTM ,intbuf_tab(nin)%NSV ,nseg ,intbuf_tab(nin)%IRTLM,
511 2 nmn ,nrtm ,mwa ,nsn ,rwa ,
512 3 noint ,intbuf_tab(nin)%MSR ,intbuf_tab(nin)%CSTS ,intbuf_tab(nin)%DPARA ,tzinf ,
513 4 ignore ,thk ,knod2els ,knod2elc ,knod2eltg ,
514 5 nod2els ,nod2elc ,nod2eltg ,
515 6 -nin ,ixc ,ixtg ,thk_part ,ipartc ,
516 7 geo ,ixs ,ixs10 ,pm ,ixs16 ,
517 8 ixs20 ,iparttg ,id,titr ,igeo ,stack ,
518 9 iworksh ,
519 1 ix1 ,ix2 ,ix3,ix4 ,nsvg ,
520 2 prov_n ,prov_e ,n11,n21 ,n31 ,
521 3 x1 ,x2 ,x3 ,x4 ,stif ,
522 4 y1 ,y2 ,y3 ,y4 ,z1 ,
523 5 z2 ,z3 ,z4 ,xi ,yi ,
524 6 zi ,x0 ,y0 ,z0 ,xn1 ,
525 7 yn1 ,zn1 ,xn2,yn2 ,zn2 ,
526 8 xn3 ,yn3 ,zn3,xn4 ,yn4 ,
527 9 zn4 ,p1 ,p2 ,p3 ,p4 ,
528 1 lb1 ,lb2 ,lb3,lb4 ,lc1 ,
529 2 lc2 ,lc3 ,lc4,s ,t ,
530 3 ilev)
531C
532C Warning : NMN, NSN, K13, K14 et K15 updated by I2TID3
533 CALL i2tid3(
534 1 x ,intbuf_tab(nin)%IRECTM ,intbuf_tab(nin)%CSTS ,intbuf_tab(nin)%MSR ,intbuf_tab(nin)%NSV ,
535 2 intbuf_tab(nin)%IRTLM ,itab ,ikine ,ikine1 ,intbuf_tab(nin)%DPARA,
536 3 ipari(1,nin) ,tzinf ,iddlevel ,
537 4 id ,titr ,intbuf_tab(nin) ,intbuf_tab(nin)%VARIABLES(4) , iproj,
538 5 ixs ,ixc ,ixs10 ,ixs16 ,ixs20,intbuf_tab(nin)%CSTS_BIS,
539 6 nsn_multi_connec ,t2_add_connec ,t2_nb_connec ,t2_connec ,ixtg)
540C
541 nsn = ipari(5,nin)
542 nmn = ipari(6,nin)
543 intth = ipari(47,nin)
544C
545 IF ((ilev >=10 .AND. ilev < 23) .OR. intth > 0) THEN
546 CALL i2surfs(
547 . x ,intbuf_tab(nin)%NSV ,intbuf_tab(nin)%AREAS2 ,nsn ,itab,
548 . ixc ,ixtg ,ixs ,knod2els ,nod2els ,
549 . knod2elc ,nod2elc ,knod2eltg ,nod2eltg ,ilev ,
550 . id ,titr )
551 ENDIF
552
553 ! -----------------
554 ! update the weight of candidate's pair for the domain decomposition
555 IF (iddlevel==0.AND.nspmd>1)THEN
556 IF ( ((nelemint+nsn)) > inter_cand%S_IXINT_2) CALL upgrade_ixint(inter_cand,nelemint,nsn)
557 CALL update_weight_inter_type2(nelemint,nin,nsn,nrtm,ifiend,
558 1 n2d,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,intbuf_tab(nin)%IRTLM,inter_cand)
559 ENDIF
560 ! -----------------
561C
562 IF(iddlevel == 0 .AND. (dectyp >= 3 .AND. dectyp <= 6))THEN
563C nodal weights and interfaces
564 CALL i2wcontdd(intbuf_tab(nin)%NSV,intbuf_tab(nin)%MSR,nsn,nmn,iwcin2,
565 + nsn2t ,nmn2t )
566 END IF
567C
568C-----------------------------------------------------------------------
569 ELSEIF(nty==3) THEN
570C-----------------------------------------------------------------------
571 !must be flushed to 0 (in old code INBUF and BUFIN
572 !flushed between 2 domain decomposition
573 intbuf_tab(nin)%LNSV(1:nst) = 0
574 intbuf_tab(nin)%LMSR(1:nmt) = 0
575 intbuf_tab(nin)%STFNS(1:nsn) = 0
576 intbuf_tab(nin)%STFNM(1:nmn) = 0
577
578 CALL inint0(
579 1 x,intbuf_tab(nin)%IRECTS,intbuf_tab(nin)%NSEGS,intbuf_tab(nin)%LNSV,intbuf_tab(nin)%NSV,
580 2 intbuf_tab(nin)%MSR,intbuf_tab(nin)%ILOCM,nmn ,nsn ,nrts ,intbuf_tab(nin)%S_IRECTS ,intbuf_tab(nin)%S_LNSV)
581 CALL inint0(
582 1 x,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSEGM,intbuf_tab(nin)%LMSR,intbuf_tab(nin)%MSR,
583 2 intbuf_tab(nin)%NSV,intbuf_tab(nin)%ILOCS,nsn,nmn ,nrtm ,intbuf_tab(nin)%S_IRECTM ,intbuf_tab(nin)%S_LMSR )
584 CALL i3sti3(
585 1 x ,intbuf_tab(nin)%IRECTS,intbuf_tab(nin)%STFS,ixs,pm ,
586 2 geo ,nrts ,ixc ,intbuf_tab(nin)%STFNS,intbuf_tab(nin)%NSEGS,
587 3 intbuf_tab(nin)%LNSV,nin ,nsn ,intbuf_tab(nin)%NSV,intbuf_tab(nin)%STFAC,
588 4 nty ,intbuf_tab(nin)%VARIABLES(2),noint ,ixtg ,irs ,
589 5 knod2els ,knod2elc ,knod2eltg ,nod2els ,nod2elc ,
590 6 nod2eltg ,igrsurf(isu1),thk ,ixs10 ,
591 7 ixs16 ,ixs20 ,id,titr,bidon ,bidon ,
592 8 bidon ,bidon ,igeo ,fillsol ,stack%pm, iworksh )
593
594 CALL i3sti3(
595 1 x ,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%STFM,ixs ,pm ,
596 2 geo ,nrtm ,ixc ,intbuf_tab(nin)%STFNM,intbuf_tab(nin)%NSEGM,
597 3 intbuf_tab(nin)%LMSR,-nin ,nmn ,intbuf_tab(nin)%MSR,intbuf_tab(nin)%STFAC,
598 4 nty ,intbuf_tab(nin)%VARIABLES(2),noint ,ixtg ,irm ,
599 5 knod2els ,knod2elc ,knod2eltg ,nod2els ,nod2elc ,
600 6 nod2eltg ,igrsurf(isu2),thk ,ixs10 ,
601 7 ixs16 ,ixs20 ,id,titr,bidon ,bidon ,
602 8 bidon ,bidon ,igeo ,fillsol ,stack%pm, iworksh )
603
604 CALL invoi3(
605 1 x,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%LMSR,intbuf_tab(nin)%MSR,intbuf_tab(nin)%NSV,
606 2 intbuf_tab(nin)%ILOCS,intbuf_tab(nin)%IRTLM,intbuf_tab(nin)%NSEGM,nsn ,nmn ,
607 3 itab,id,titr,nrtm)
608
609 CALL invoi3(
610 1 x,intbuf_tab(nin)%IRECTS,intbuf_tab(nin)%LNSV,intbuf_tab(nin)%NSV,intbuf_tab(nin)%MSR,
611 2 intbuf_tab(nin)%ILOCM,intbuf_tab(nin)%IRTLS,intbuf_tab(nin)%NSEGS,nmn ,nsn ,
612 3 itab,id,titr,nrts)
613
614 WRITE(iout,2002)
615 CALL i3pen3(
616 1 x,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%MSR,intbuf_tab(nin)%NSV,intbuf_tab(nin)%ILOCS,
617 2 intbuf_tab(nin)%IRTLM,intbuf_tab(nin)%CSTS,intbuf_tab(nin)%IRTLOM,intbuf_tab(nin)%VARIABLES(2),nsn,
618 2 itab ,iwpene ,id,titr)
619
620 WRITE(iout,2003)
621 CALL i3pen3(
622 1 x,intbuf_tab(nin)%IRECTS,intbuf_tab(nin)%NSV,intbuf_tab(nin)%MSR,intbuf_tab(nin)%ILOCM,
623 2 intbuf_tab(nin)%IRTLS,intbuf_tab(nin)%CSTM,intbuf_tab(nin)%IRTLOS,intbuf_tab(nin)%VARIABLES(2),nmn,
624 3 itab ,iwpene ,id,titr)
625
626C
627
628C-----------------------------------------------------------------------
629 ELSEIF(nty==5) THEN
630C-----------------------------------------------------------------------
631 !must be flushed to 0 (in old code INBUF and BUFIN
632 !flushed between 2 domain decomposition
633 intbuf_tab(nin)%LNSV(1:nst) = 0
634 intbuf_tab(nin)%LMSR(1:nmt) = 0
635 intbuf_tab(nin)%STFNS(1:nsn) = 0
636 intbuf_tab(nin)%STFNM(1:nmn) = 0
637
638 CALL inint0(
639 1 x,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSEGM,intbuf_tab(nin)%LMSR,intbuf_tab(nin)%MSR,
640 2 intbuf_tab(nin)%NSV,intbuf_tab(nin)%ILOCS,nsn ,nmn ,nrtm ,intbuf_tab(nin)%S_IRECTM ,intbuf_tab(nin)%S_LMSR)
641 CALL i3sti3(
642 1 x ,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%STFM,ixs ,pm ,
643 2 geo ,nrtm ,ixc ,intbuf_tab(nin)%STFNM, intbuf_tab(nin)%NSEGM ,
644 3 intbuf_tab(nin)%LMSR,-nin ,nmn ,intbuf_tab(nin)%MSR,intbuf_tab(nin)%STFAC(1),
645 4 nty ,intbuf_tab(nin)%VARIABLES(2),noint ,ixtg ,irm ,
646 5 knod2els ,knod2elc ,knod2eltg ,nod2els ,nod2elc ,
647 6 nod2eltg ,igrsurf(isu2),thk ,ixs10 ,
648 7 ixs16 ,ixs20 ,id,titr,bidon ,bidon ,
649 8 bidon ,bidon ,igeo ,fillsol ,stack%pm, iworksh)
650 CALL invoi3(
651 1 x,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%LMSR,intbuf_tab(nin)%MSR,intbuf_tab(nin)%NSV,
652 2 intbuf_tab(nin)%ILOCS,intbuf_tab(nin)%IRTLM,intbuf_tab(nin)%NSEGM,nsn ,nmn ,
653 3 itab,id,titr,nrtm)
654 WRITE(iout,2002)
655 CALL i3pen3(
656 1 x,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%MSR,intbuf_tab(nin)%NSV,intbuf_tab(nin)%ILOCS,
657 2 intbuf_tab(nin)%IRTLM,intbuf_tab(nin)%CSTS,intbuf_tab(nin)%IRTLOM,intbuf_tab(nin)%VARIABLES(2),
658 3 nsn, itab ,iwpene ,id,titr)
659 IF(inacti==3 .OR. inacti==4)THEN
660 CALL i5pwr3(
661 1 x,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%MSR,intbuf_tab(nin)%NSV,intbuf_tab(nin)%ILOCS,
662 2 intbuf_tab(nin)%IRTLM,intbuf_tab(nin)%CSTS,intbuf_tab(nin)%IRTLOM,intbuf_tab(nin)%VARIABLES(2),
663 3 nsn, itab ,inacti )
664 END IF
665C
666
667C-----------------------------------------------------------------------
668 ELSEIF(nty==7) THEN
669C-----------------------------------------------------------------------
670 drad = intbuf_tab(nin)%VARIABLES(32)
671
672 IF(intbuf_tab(nin)%S_NIGE/=0) THEN
673 ALLOCATE(xe(3*(numnod+intbuf_tab(nin)%S_NIGE)))
674 xe(1:3*numnod) = x(1:3*numnod)
675 xe(3*numnod+1:3*(numnod+intbuf_tab(nin)%S_NIGE)) = intbuf_tab(nin)%XIGE(1:3*intbuf_tab(nin)%S_NIGE)
676 ptr_x(3*numnod+1:3*(numnod+intbuf_tab(nin)%S_NIGE)) => xe(3*numnod+1:3*(numnod+intbuf_tab(nin)%S_NIGE))
677 ptr_ms(1:numnod) => ms(1:numnod)
678 numnod_p = numnod+intbuf_tab(nin)%S_NIGE
679 ELSEIF(law151_type18) THEN
680 ptr_x(1:numnod+numels) => x_append(1:3*s_append_array)
681 ptr_ms(1:numnod+numels) => mass_append(1:s_append_array)
682 numnod_p = numnod+numels
683 ELSE
684 ptr_x(1:numnod) => x(1:numnod)
685 ptr_ms(1:numnod) => ms(1:numnod)
686 numnod_p = numnod
687 ENDIF
688
689 CALL i7err3(
690 1 ptr_x ,nrtm ,intbuf_tab(nin)%IRECTM , noint, itab,id,titr,
691 2 ix1 ,ix2 ,ix3 ,ix4 ,x1 ,
692 3 x2 ,x3 ,x4 ,y1 ,y2 ,
693 4 y3 ,y4 ,z1 ,z2 ,z3 ,
694 5 z4 ,n11 ,n21 ,n31 ,x0 ,
695 6 y0 ,z0 ,xn1 ,yn1 ,zn1 ,
696 7 xn2 ,yn2 ,zn2 ,xn3 ,yn3 ,
697 8 zn3 ,xn4 ,yn4 ,zn4 )
698C----------------
699C NODAL AND ELEMENTARY STIFFNESS
700C----------------
701 CALL i7sti3(
702 1 ptr_x ,intbuf_tab(nin)%IRECTM , intbuf_tab(nin)%STFM , ixs , pm ,
703 2 geo ,nrtm_fe , ixc ,-nin , intbuf_tab(nin)%STFAC,
704 3 nty ,intbuf_tab(nin)%VARIABLES(2) , noint ,intbuf_tab(nin)%STFNS , nsn ,
705 4 ptr_ms ,intbuf_tab(nin)%NSV , ixtg ,igap , rwa ,
706 5 intbuf_tab(nin)%GAP_S ,intbuf_tab(nin)%GAP_M ,intbuf_tab(nin)%VARIABLES(13),ixt , ixp ,
707 6 intbuf_tab(nin)%VARIABLES(6),intbuf_tab(nin)%VARIABLES(16),inacti ,knod2els , knod2elc ,
708 7 knod2eltg ,nod2els ,nod2elc ,nod2eltg , igrsurf(isu2) ,
709 8 ipari(47,nin) ,intbuf_tab(nin)%IELES ,intbuf_tab(nin)%IELEC ,intbuf_tab(nin)%AREAS , sh4tree ,
710 9 sh3tree ,ipart ,ipartc ,iparttg , thk ,
711 c thk_part ,intbuf_tab(nin)%VARIABLES(28),intbuf_tab(nin)%GAP_SL,intbuf_tab(nin)%GAP_ML,nod2el1d ,
712 d knod2el1d ,ixr ,itab ,intbuf_tab(nin)%VARIABLES(7),ixs10 ,
713 e ixs16 ,ixs20 ,id ,titr , iddlevel ,
714 f drad ,igeo ,fillsol ,stack%pm , iworksh ,
715 g it19 ,kxig3d ,ixig3d ,ipari(72,nin) , iparts ,
716 h tagprt_fric ,intbuf_tab(nin)%IPARTFRICS ,intbuf_tab(nin)%IPARTFRICM ,intbuf_fric_tab,nrtm_ige ,
717 i ipari(63,nin) ,gapm_mx ,gaps_mx ,gapm_l_mx ,gaps_l_mx ,
718 j ipartt ,ipartp ,ipartr ,elem_linked_to_segment,
719 k flag_elem_inter25 )
720 ipari(21,nin) = igap
721C
722C----------------
723C IREM GAP
724C----------------
725 IF (iremnode == 1) THEN ! IDDLEVEL == 1 !
726C
727 CALL i7remnode(iremnode,noint,titr,intbuf_tab(nin),numnod+numfakenodigeo ,
728 1 x,nrtm ,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,nsn,
729 2 itab ,intbuf_tab(nin)%GAP_S,intbuf_tab(nin)%GAP_M,intbuf_tab(nin)%VARIABLES(13),intbuf_tab(nin)%VARIABLES(16),
730 3 intbuf_tab(nin)%GAP_SL,intbuf_tab(nin)%GAP_ML,igap,intbuf_tab(nin)%VARIABLES(2),drad ,
731 4 ipari(62,nin) ,nty ,ipari(1,nin) ,i_mem_rem ,gapm_mx ,
732 5 gaps_mx ,gapm_l_mx ,gaps_l_mx ,ilev ,intbuf_tab(nin)%NBINFLG ,
733 6 intbuf_tab(nin)%MBINFLG,intbuf_tab(nin)%VARIABLES(46),npari)
734C
735 END IF
736C----------------
737C VOXEL SORT
738C----------------
739 is_used_with_law151 = .false.
740 IF(multi_fvm%IS_INTER_USED_WITH_LAW151(nin) == 1)is_used_with_law151 = .true.
741
742 CALL i7buc_vox1(
743 1 ptr_x ,intbuf_tab(nin)%IRECTM ,intbuf_tab(nin)%NSV,intbuf_tab(nin)%VARIABLES(4),nseg ,
744 2 nmn ,nrtm ,mwa ,nsn ,
745 3 intbuf_tab(nin)%VARIABLES(2),rwa ,noint ,intbuf_tab(nin)%I_STOK(1) ,
746 4 intbuf_tab(nin)%VARIABLES(5),intbuf_tab(nin)%VARIABLES(8), intbuf_tab(nin)%MSR ,
747 5 intbuf_tab(nin)%STFM ,intbuf_tab(nin)%STFNS ,multimp ,1 ,iddlevel ,
748 6 itab ,intbuf_tab(nin)%GAP_S ,intbuf_tab(nin)%GAP_M, igap,intbuf_tab(nin)%VARIABLES(13),
749 7 intbuf_tab(nin)%VARIABLES(16) ,inacti ,intbuf_tab(nin)%GAP_SL,intbuf_tab(nin)%GAP_ML ,i_mem ,
750 8 ncont ,icurv ,intbuf_tab(nin)%VARIABLES(7), id , titr ,
751 9 drad ,intercep, nin,
752 1 iremnode ,ipari(63,nin),intbuf_tab(nin)%KREMNODE,intbuf_tab(nin)%REMNODE,
753 2 intbuf_tab(nin)%VARIABLES(46),npari,ipari(1,nin),intbuf_tab(nin), is_used_with_law151)
754C I_STOK updated for searching optimization
755 i_stok=intbuf_tab(nin)%I_STOK(1)
756
757 IF (i_mem == 2 ) RETURN
758
759
760
761 ! -----------------
762 ! update the weight of candidate's pair for the domain decomposition
763 IF (iddlevel==0.AND.nspmd>1)THEN
764 IF ( ((nelemint+i_stok)) > inter_cand%S_IXINT_2) CALL upgrade_ixint(inter_cand,nelemint,i_stok)
765
766 gap = intbuf_tab(nin)%VARIABLES(2)
767 gapmin = intbuf_tab(nin)%VARIABLES(13)
768 gapmax = intbuf_tab(nin)%VARIABLES(16)
769 dgapload = intbuf_tab(nin)%VARIABLES(46)
770 CALL update_weight_inter_type7(nelemint,nin,nsn,nrtm,ifiend,
771 . intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,i_stok,intbuf_tab(nin)%CAND_E,intbuf_tab(nin)%CAND_N,
772 . igap,gap,gapmax,gapmin,dgapload,
773 . drad,intbuf_tab(nin)%GAP_S,intbuf_tab(nin)%GAP_SL,intbuf_tab(nin)%GAP_M,intbuf_tab(nin)%GAP_ML,
774 . numnod_p,ptr_x,inter_cand)
775 ENDIF
776 ! -----------------
777
778 IF((iddlevel==0).AND.(dectyp>=3.AND.dectyp<=6))THEN
779C Weighting interface nodes
780 IF(law151_type18)THEN
781 ! specific treatment with colocated scheme (/MAT/LAW151)
782 grbric_id = ipari(83,nin)
783 nbric = igrbric(isu1)%NENTITY
784 CALL iwcontdd_151(igrbric(grbric_id)%ENTITY,nbric,intbuf_tab(nin)%MSR,nmn_fe,iwcont,nsnt,nmnt,
785 . numnod,ixs,numels,ale_connectivity%NALE)
786 ELSE
787 CALL iwcontdd(intbuf_tab(nin)%NSV,intbuf_tab(nin)%MSR,nsn_fe,nmn_fe,iwcont,nsnt,nmnt)
788 ENDIF
789 END IF
790C
791C INITIAL PENETRATION I7PEN3
792C
793 IF (iddlevel>0)THEN ! optim initial penetration (2nd passage only in order not to modify candidate list)
794 ngrous=1+(i_stok-1)/nvsiz
795C
796 DO ng=1,ngrous
797 IF(ipri>=1) WRITE(iout,2007)
798 nft = (ng-1) * nvsiz
799 lft = 1
800 llt = min0( nvsiz, i_stok - nft )
801
802 CALL i7cor3(
803 1 ptr_x ,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,intbuf_tab(nin)%CAND_E(1+nft),intbuf_tab(nin)%CAND_N(1+nft) ,
804 2 intbuf_tab(nin)%STFM,intbuf_tab(nin)%STFNS,gapv ,igap ,intbuf_tab(nin)%VARIABLES(2) ,
805 3 intbuf_tab(nin)%GAP_S,intbuf_tab(nin)%GAP_M,1,intbuf_tab(nin)%VARIABLES(13),intbuf_tab(nin)%VARIABLES(16),
806 4 intbuf_tab(nin)%GAP_SL,intbuf_tab(nin)%GAP_ML,zero,ix1 ,ix2 ,
807 5 ix3 ,ix4 ,nsvg,x1 ,x2 ,
808 6 x3 ,x4 ,y1 ,y2 ,y3 ,
809 7 y4 ,z1 ,z2 ,z3 ,z4 ,
810 8 xi ,yi ,zi ,stif ,zero ,
811 9 llt)
812 CALL i7dst3(ix3,ix4,x1 ,x2 ,x3 ,
813 1 x4 ,y1 ,y2 ,y3 ,y4 ,
814 2 z1 ,z2 ,z3 ,z4 ,xi ,
815 3 yi ,zi ,x0 ,y0 ,z0 ,
816 4 xn1,yn1,zn1,xn2,yn2,
817 5 zn2,xn3,yn3,zn3,xn4,
818 6 yn4,zn4,p1 ,p2 ,p3 ,
819 7 p4 ,lb1,lb2,lb3,lb4,
820 8 lc1,lc2,lc3,lc4,llt)
821 CALL i7pen3(zero,gapv,n11,n21,n31 ,
822 1 pene ,xn1 ,yn1,zn1,xn2,
823 2 yn2 ,zn2 ,xn3,yn3,zn3,
824 3 xn4 ,yn4 ,zn4,p1 ,p2 ,
825 4 p3 ,p4,llt)
826 IF(inacti==7)THEN
827 CALL i18pwr3(itab ,inacti,intbuf_tab(nin)%CAND_E(1+nft),intbuf_tab(nin)%CAND_N(1+nft),intbuf_tab(nin)%STFNS,
828 1 intbuf_tab(nin)%STFM,ptr_x ,intbuf_tab(nin)%NSV,iwpene ,intbuf_tab(nin)%CAND_P,
829 2 intbuf_tab(nin)%CAND_E,intbuf_tab(nin)%CAND_N,mwa ,noint ,gapv ,
830 3 ix1,ix2,ix3,ix4,nsvg,
831 4 pene)
832 ELSE
833 fpenmax = intbuf_tab(nin)%VARIABLES(27)
834 CALL i7pwr3(itab ,inacti,intbuf_tab(nin)%CAND_E(1+nft),intbuf_tab(nin)%CAND_N(1+nft),intbuf_tab(nin)%STFNS,
835 1 intbuf_tab(nin)%STFM,ptr_x ,intbuf_tab(nin)%NSV,iwpene ,intbuf_tab(nin)%CAND_P,
836 2 intbuf_tab(nin)%CAND_E,intbuf_tab(nin)%CAND_N,mwa , noint ,gapv ,
837 3 nty ,itied ,fpenmax ,id ,titr ,
838 4 iddlevel ,iremnode ,intbuf_tab(nin)%KREMNODE,intbuf_tab(nin)%REMNODE,istok,
839 5 ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
840 6 x1 ,x2 ,x3 ,x4 ,y1 ,
841 7 y2 ,y3 ,y4 ,z1 ,z2 ,
842 8 z3 ,z4 ,xi ,yi ,zi ,
843 9 n11 ,n21 ,n31 ,pene )
844 ENDIF
845 IF(iwpene/=0.AND.inacti==3.OR.inacti==4) iwrn = 1
846 ENDDO
847 CALL ancmsg(msgid=1164,msgtype=msgwarning,anmode=aninfo_blind_1,i1=id,c1=titr,prmod=msg_print)
848 DO i=1,numnod+numfakenodigeo
849 inpene=inpene+min(mwa(i),1)
850 ENDDO
851 IF(istok==0.AND.(inacti==5.OR.inacti==6))ipari(22,nin) = -inacti ! Negative passage for sizing
852 intbuf_tab(nin)%I_STOK(1)=istok
853 ENDIF
854C
855 ELSEIF(nty==8) THEN
856 CALL inint0_8(x,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSEGM,intbuf_tab(nin)%LMSR,
857 . intbuf_tab(nin)%MSR,
858 1 intbuf_tab(nin)%NSV,intbuf_tab(nin)%ILOCS,nsn ,nmn ,nrtm ,
859 2 numnod)
860 CALL i3sti3(
861 1 x ,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%STFM,ixs ,pm ,
862 2 geo ,nrtm ,ixc ,intbuf_tab(nin)%STFNM,intbuf_tab(nin)%NSEGM,
863 3 intbuf_tab(nin)%LMSR,-nin ,nmn ,intbuf_tab(nin)%MSR,intbuf_tab(nin)%STFAC(1),
864 4 nty ,intbuf_tab(nin)%VARIABLES(2),noint ,ixtg ,irs ,
865 5 knod2els ,knod2elc ,knod2eltg ,nod2els ,nod2elc ,
866 6 nod2eltg ,igrsurf(isu2),thk ,ixs10 ,
867 7 ixs16 ,ixs20 ,id,titr,intbuf_tab(nin)%GAPN,intbuf_tab(nin)%STF8 ,
868 8 intbuf_tab(nin)%VARIABLES(5),intbuf_tab(nin)%VARIABLES(4), igeo ,fillsol ,
869 9 stack%pm , iworksh)
870 CALL invoi3(
871 1 x,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%LMSR,intbuf_tab(nin)%MSR,intbuf_tab(nin)%NSV,
872 2 intbuf_tab(nin)%ILOCS,intbuf_tab(nin)%IRTLM,intbuf_tab(nin)%NSEGM,nsn ,nmn ,
873 3 itab,id,titr,nrtm)
874 WRITE(iout,2002)
875 CALL i3pen3(
876 1 x ,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%MSR,intbuf_tab(nin)%NSV,intbuf_tab(nin)%ILOCS,
877 2 intbuf_tab(nin)%IRTLM,intbuf_tab(nin)%CSTS,intbuf_tab(nin)%IRTLOM,intbuf_tab(nin)%VARIABLES(2),nsn ,
878 3 itab ,iwpene ,id,titr)
879C-----------------------------------------------------------------------
880 ELSEIF(nty==9) THEN
881C-----------------------------------------------------------------------
882
883 !must be flushed to 0 (in old code INBUF and BUFIN
884 !flushed between 2 domain decomposition
885 intbuf_tab(nin)%LNSV(1:nst) = 0
886 intbuf_tab(nin)%LMSR(1:nmt) = 0
887 intbuf_tab(nin)%STFNS(1:nsn) = 0
888 intbuf_tab(nin)%STFNM(1:nmn) = 0
889
890 CALL inint0(
891 1 x,intbuf_tab(nin)%IRECTS,intbuf_tab(nin)%NSEGS,intbuf_tab(nin)%LNSV,intbuf_tab(nin)%NSV,
892 2 intbuf_tab(nin)%MSR,intbuf_tab(nin)%ILOCM,nmn ,nsn ,nrts ,intbuf_tab(nin)%S_IRECTS ,
893 3 intbuf_tab(nin)%S_LNSV)
894 CALL inint0(
895 1 x,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSEGM,intbuf_tab(nin)%LMSR,intbuf_tab(nin)%MSR,
896 2 intbuf_tab(nin)%NSV,intbuf_tab(nin)%ILOCS,nsn ,nmn ,nrtm ,intbuf_tab(nin)%S_IRECTM ,
897 3 intbuf_tab(nin)%S_LMSR )
898
899 CALL i9sti3(
900 1 x ,intbuf_tab(nin)%IRECTS, intbuf_tab(nin)%STFS ,ixs ,
901 2 nrts ,
902 3 nin ,nsn , intbuf_tab(nin)%NSV ,
903 4 noint , intbuf_tab(nin)%IELES,
904 5 knod2els ,nod2els , igrsurf ,isu1 ,
905 6 ixs10 ,ixs16 ,ixs20 , id ,titr)
906 CALL i9sti3(
907 1 x ,intbuf_tab(nin)%IRECTM, intbuf_tab(nin)%STFM ,ixs ,
908 2 nrtm ,
909 3 -nin ,nmn , intbuf_tab(nin)%MSR ,
910 4 noint , intbuf_tab(nin)%IELEM,
911 5 knod2els ,nod2els , igrsurf ,isu2 ,
912 6 ixs10 ,ixs16 , ixs20 , id ,titr)
913 CALL invoi3(
914 1 x,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%LMSR,intbuf_tab(nin)%MSR,intbuf_tab(nin)%NSV,
915 2 intbuf_tab(nin)%ILOCS,intbuf_tab(nin)%IRTLM,intbuf_tab(nin)%NSEGM,nsn ,nmn ,
916 3 itab,id,titr,nrtm)
917 CALL invoi3(
918 1 x,intbuf_tab(nin)%IRECTS,intbuf_tab(nin)%LNSV,intbuf_tab(nin)%NSV,intbuf_tab(nin)%MSR,
919 2 intbuf_tab(nin)%ILOCM,intbuf_tab(nin)%IRTLS,intbuf_tab(nin)%NSEGS,nmn ,nsn ,
920 3 itab,id,titr,nrts)
921 IF(nmn>0)THEN
922 WRITE(iout,2002)
923 CALL i3pen3(
924 1 x,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%MSR,intbuf_tab(nin)%NSV,intbuf_tab(nin)%ILOCS,
925 2 intbuf_tab(nin)%IRTLM,intbuf_tab(nin)%CSTS,intbuf_tab(nin)%IRTLOM,intbuf_tab(nin)%VARIABLES(2),nsn,
926 3 itab ,iwpene ,id,titr)
927 WRITE(iout,2003)
928 CALL i3pen3(
929 1 x,intbuf_tab(nin)%IRECTS,intbuf_tab(nin)%NSV,intbuf_tab(nin)%MSR,intbuf_tab(nin)%ILOCM,
930 2 intbuf_tab(nin)%IRTLS,intbuf_tab(nin)%CSTM,intbuf_tab(nin)%IRTLOS,intbuf_tab(nin)%VARIABLES(2),nmn,
931 3 itab ,iwpene ,id,titr)
932 ENDIF
933 CALL i9bcs_check(icode, sicode, nsn, intbuf_tab(nin)%NSV, intbuf_tab(nin)%S_ILOCS, intbuf_tab(nin)%ILOCS )
934C-----------------------------------------------------------------------
935 ELSEIF(nty==10) THEN
936C-----------------------------------------------------------------------
937C K14 = CANDIDATE ELEMENTS...
938C K15 = CANDIDATE NODES + INDEXES
939 itied=nint(intbuf_tab(nin)%VARIABLES(1))
940C
941C NODAL AND ELEMENTARY STIFFNESS
942C
943 ibidon = 0
944 bidon = zero
945
946 CALL i7sti3(
947 1 x ,intbuf_tab(nin)%IRECTM ,intbuf_tab(nin)%STFM ,ixs ,pm ,
948 2 geo ,nrtm ,ixc ,-nin ,intbuf_tab(nin)%STFAC,
949 3 nty ,intbuf_tab(nin)%VARIABLES(2) ,noint ,intbuf_tab(nin)%STFNS, nsn ,
950 4 ms ,intbuf_tab(nin)%NSV ,ixtg ,igap , rwa ,
951 5 intbuf_tab(nin)%GAP_S ,intbuf_tab(nin)%GAP_M ,intbuf_tab(nin)%VARIABLES(13),ixt ,ixp ,
952 6 intbuf_tab(nin)%VARIABLES(6),intbuf_tab(nin)%VARIABLES(16),inacti ,knod2els ,knod2elc,
953 9 knod2eltg ,nod2els ,nod2elc ,nod2eltg ,igrsurf(isu2),
954 a ibidon ,ibidon ,ibidon ,bidon ,sh4tree ,
955 b sh3tree ,ipart ,ipartc ,iparttg ,thk ,
956 c thk_part ,intbuf_tab(nin)%VARIABLES(27),rdum ,rdum ,nod2el1d,
957 d knod2el1d ,ixr ,itab ,intbuf_tab(nin)%VARIABLES(7) ,ixs10 ,
958 e ixs16 ,ixs20 ,id ,titr ,iddlevel,
959 f drad ,igeo ,fillsol ,stack%pm ,iworksh ,
960 g it19 ,bid ,bid ,ibidon ,iparts ,
961 h ibidon ,ibidon ,ibidon ,ibidon ,ibidon ,
962 i ipari(63,nin),gapm_mx ,gaps_mx ,gapm_l_mx ,gaps_l_mx,
963 j ipartt ,ipartp ,ipartr ,elem_linked_to_segment,
964 k flag_elem_inter25 )
965C
966C REMAINING BUCKET SORT IN STARTER
967C
968 maxbox = intbuf_tab(nin)%VARIABLES(9)
969 minbox = intbuf_tab(nin)%VARIABLES(12)
970 CALL i7buc1(
971 1 x ,intbuf_tab(nin)%IRECTM ,intbuf_tab(nin)%NSV,intbuf_tab(nin)%VARIABLES(4),nseg,
972 2 nmn ,nrtm ,mwa ,nsn ,intbuf_tab(nin)%CAND_E,
973 3 intbuf_tab(nin)%CAND_N ,intbuf_tab(nin)%VARIABLES(2),rwa ,noint ,i_stok ,
974 4 intbuf_tab(nin)%VARIABLES(5),intbuf_tab(nin)%VARIABLES(8),maxbox ,minbox ,intbuf_tab(nin)%MSR ,
975 5 intbuf_tab(nin)%STFM ,intbuf_tab(nin)%STFNS ,multimp ,1 ,iddlevel ,
976 6 itab ,intbuf_tab(nin)%GAP_S ,intbuf_tab(nin)%GAP_M,igap ,intbuf_tab(nin)%VARIABLES(13),
977 7 intbuf_tab(nin)%VARIABLES(16) ,inacti ,rdum,rdum ,i_mem ,
978 8 id,titr,it19,prov_n,prov_e,
979 9 nsvg,ix1 ,ix2 ,ix3 ,ix4 ,
980 1 n11 ,n21 ,n31 ,pene ,x1 ,
981 2 x2 ,x3 ,x4 ,y1 ,y2 ,
982 3 y3 ,y4 ,z1 ,z2 ,z3 ,
983 4 z4 ,xi ,yi ,zi ,x0 ,
984 5 y0 ,z0 ,xn1 ,yn1 ,zn1 ,
985 6 xn2 ,yn2 ,zn2 ,xn3 ,yn3 ,
986 7 zn3 ,xn4 ,yn4 ,zn4 ,p1 ,
987 8 p2 ,p3 ,p4 ,lb1 ,lb2 ,
988 9 lb3 ,lb4 ,lc1 ,lc2 ,lc3 ,
989 1 lc4,stif)
990 IF (i_mem == 2) RETURN
991 intbuf_tab(nin)%VARIABLES(9) = maxbox
992 intbuf_tab(nin)%VARIABLES(12) = minbox
993C
994C COMPUTE INITIAL PENETRATION WITH I7PEN3
995C
996 ngrous=1+(i_stok-1)/nvsiz
997C
998 DO ng=1,ngrous
999 IF(ipri>=1) WRITE(iout,2007)
1000 nft = (ng-1) * nvsiz
1001 lft = 1
1002 llt = min0( nvsiz, i_stok - nft )
1003 CALL i7cor3(
1004 1 x ,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,intbuf_tab(nin)%CAND_E(1+nft),intbuf_tab(nin)%CAND_N(1+nft) ,
1005 2 intbuf_tab(nin)%STFM,intbuf_tab(nin)%STFNS,gapv ,igap ,intbuf_tab(nin)%VARIABLES(2) ,
1006 3 intbuf_tab(nin)%GAP_S,intbuf_tab(nin)%GAP_M,1,intbuf_tab(nin)%VARIABLES(13),intbuf_tab(nin)%VARIABLES(16),
1007 4 rdum,rdum,drad,ix1 ,ix2 ,
1008 5 ix3 ,ix4 ,nsvg,x1 ,x2 ,
1009 6 x3 ,x4 ,y1 ,y2 ,y3 ,
1010 7 y4 ,z1 ,z2 ,z3 ,z4 ,
1011 8 xi ,yi ,zi ,stif ,intbuf_tab(nin)%VARIABLES(46),
1012 9 llt)
1013 CALL i7dst3(ix3,ix4,x1 ,x2 ,x3 ,
1014 1 x4 ,y1 ,y2 ,y3 ,y4 ,
1015 2 z1 ,z2 ,z3 ,z4 ,xi ,
1016 3 yi ,zi ,x0 ,y0 ,z0 ,
1017 4 xn1,yn1,zn1,xn2,yn2,
1018 5 zn2,xn3,yn3,zn3,xn4,
1019 6 yn4,zn4,p1 ,p2 ,p3 ,
1020 7 p4 ,lb1,lb2,lb3,lb4,
1021 8 lc1,lc2,lc3,lc4,llt)
1022 CALL i7pen3(zero,gapv,n11,n21,n31,
1023 1 pene ,xn1 ,yn1,zn1,xn2,
1024 2 yn2 ,zn2 ,xn3,yn3,zn3,
1025 3 xn4 ,yn4 ,zn4,p1 ,p2 ,
1026 4 p3 ,p4,llt)
1027 inacti = 0
1028 fpenmax = intbuf_tab(nin)%VARIABLES(27)
1029 CALL i7pwr3(itab ,inacti,intbuf_tab(nin)%CAND_E(1+nft),intbuf_tab(nin)%CAND_N(1+nft),intbuf_tab(nin)%STFNS,
1030 1 intbuf_tab(nin)%STFM,x ,intbuf_tab(nin)%NSV,iwpene ,intbuf_tab(nin)%CAND_P,
1031 2 intbuf_tab(nin)%CAND_E,intbuf_tab(nin)%CAND_N,mwa , noint ,gapv ,
1032 3 nty ,itied ,fpenmax ,id ,titr ,
1033 4 iddlevel ,iremnode ,ibidon ,ibidon ,istok ,
1034 5 ix1,ix2,ix3,ix4,nsvg,
1035 6 x1 ,x2 ,x3 ,x4 ,y1 ,
1036 7 y2 ,y3 ,y4 ,z1 ,z2 ,
1037 8 z3 ,z4 ,xi ,yi ,zi ,
1038 9 n11,n21,n31,pene)
1039 IF(iwpene /= 0 .AND. inacti == 3 .OR. inacti == 4) iwrn = 1
1040 ENDDO
1041 CALL ancmsg(msgid=1164,msgtype=msgwarning,anmode=aninfo_blind_1,i1=id,c1=titr,prmod=msg_print)
1042
1043 DO i=1,numnod
1044 inpene=inpene+min(mwa(i),1)
1045 ENDDO
1046 IF((iddlevel==0).AND.
1047 + (dectyp >= 3 .AND. dectyp <= 6))THEN
1048C nodal weights and interface
1049 CALL iwcontdd(intbuf_tab(nin)%NSV,intbuf_tab(nin)%MSR,nsn,nmn,iwcont,
1050 . nsnt,nmnt)
1051 END IF
1052C-----------------------------------------------------------------------
1053 ELSEIF(nty==11) THEN
1054C-----------------------------------------------------------------------
1055C ELEMSTIFFNESS
1056C
1057 gap0 =intbuf_tab(nin)%VARIABLES(2)
1058 gapinf = ep30
1059
1060C this initialization is necessary only after calling i11edge in lecins
1061C which compacts the segments on two locations
1062C they are on four locations when reading:[2 filled boxes then two empty boxes]
1063C this specific initialization is therefore done in inint3 outside bufinti
1064C only place where BUFINTI is called after calling i11edge
1065C => for the engine everything is on two locations
1066
1067C INTBUF_TAB(NIN)%VARIABLES(1) EST MODIFIE PAR I11STI3; GAP0 NON
1068
1069 CALL i11sti3(
1070 1 x ,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%STFM ,ixs ,pm ,
1071 2 geo ,nrtm ,ixc ,nin ,intbuf_tab(nin)%STFAC,
1072 3 nty ,intbuf_tab(nin)%VARIABLES(2),noint ,intbuf_tab(nin)%GAP_M,
1073 4 ms ,ixtg ,ixt ,ixp ,ixr ,
1074 5 igap ,intbuf_tab(nin)%VARIABLES(13),gap0 ,gapinf ,ipartc ,
1075 6 iparttg ,thk ,thk_part ,intbuf_tab(nin)%VARIABLES(28),intbuf_tab(nin)%GAP_ML,
1076 7 nod2el1d ,knod2el1d ,itab ,ixs10 ,id,titr ,
1077 8 kxx ,ixx ,igeo ,knod2els ,knod2elc ,
1078 9 knod2eltg ,nod2els ,nod2elc ,nod2eltg ,lelx ,
1079 a fillsol ,intth ,drad ,intbuf_tab(nin)%AREAM ,intbuf_tab(nin)%IELES ,
1080 b stack%pm ,iworksh ,it19 ,intbuf_tab(nin)%VARIABLES(7),ipari(72,nin) ,
1081 c iparts ,tagprt_fric ,intbuf_tab(nin)%IPARTFRICM,intbuf_fric_tab,
1082 d ipartt ,ipartp ,ipartx ,ipartr, ipari(63,nin))
1083C
1084 drad = intbuf_tab(nin)%VARIABLES(24)
1085 CALL i11sti3(
1086 1 x ,intbuf_tab(nin)%IRECTS,intbuf_tab(nin)%STFS ,ixs ,pm ,
1087 2 geo ,nrts ,ixc ,-nin,intbuf_tab(nin)%STFAC(1),
1088 3 nty ,intbuf_tab(nin)%VARIABLES(2),noint ,intbuf_tab(nin)%GAP_S,
1089 4 ms ,ixtg ,ixt ,ixp ,ixr ,
1090 5 igap ,intbuf_tab(nin)%VARIABLES(13),gap0 ,gapinf ,ipartc ,
1091 6 iparttg ,thk ,thk_part ,intbuf_tab(nin)%VARIABLES(28),intbuf_tab(nin)%GAP_SL,
1092 7 nod2el1d ,knod2el1d ,itab ,ixs10 ,id,titr ,
1093 8 kxx ,ixx ,igeo ,knod2els ,knod2elc ,
1094 9 knod2eltg ,nod2els ,nod2elc ,nod2eltg ,lelx ,
1095 a fillsol ,intth , drad ,intbuf_tab(nin)%AREAS,intbuf_tab(nin)%IELEC,
1096 b stack%pm ,iworksh ,it19 ,intbuf_tab(nin)%VARIABLES(7),ipari(72,nin) ,
1097 c iparts ,tagprt_fric,intbuf_tab(nin)%IPARTFRICS,intbuf_fric_tab,
1098 d ipartt ,ipartp ,ipartx ,ipartr, ipari(63,nin))
1099C
1100 intbuf_tab(nin)%VARIABLES(6)=max(gapinf,intbuf_tab(nin)%VARIABLES(13))
1101C
1102C STILL ONE BUCKET SORT
1103C
1104 maxbox = intbuf_tab(nin)%VARIABLES(9)
1105 minbox = intbuf_tab(nin)%VARIABLES(12)
1106C
1107 IF (iremnode == 1) THEN
1108C
1109 ALLOCATE(inod2lin(numnod+1),tagsecnd(numnod),nod2lin(2*nrtm))
1110 i_start = 1
1111 i_mem_rem = 0
1112 DO WHILE (i_start < nrtm)
1113C
1114 CALL i11remline(
1115 1 x,nrtm,intbuf_tab(nin)%IRECTM,nrts,intbuf_tab(nin)%IRECTS,
1116 2 numnod,intbuf_tab(nin)%GAP_S,intbuf_tab(nin)%GAP_M,intbuf_tab(nin)%VARIABLES(13),igap,
1117 3 intbuf_tab(nin)%KREMNODE,intbuf_tab(nin)%REMNODE, intbuf_tab(nin)%VARIABLES(2), drad,ipari(62,nin),
1118 4 i_start,i_mem_rem,inod2lin,tagsecnd,nod2lin,
1119 5 intbuf_tab(nin)%VARIABLES(46),intbuf_tab(nin)%GAP_SL,intbuf_tab(nin)%GAP_ML)
1120C
1121C Reallocation of REMNODE arrays if necessary
1122C
1123 IF (i_mem_rem == 1) THEN
1124 new_size = ipari(62,nin) + 5*nrtm
1125 CALL upgrade_remnode(ipari(1,nin),new_size,intbuf_tab(nin),nty)
1126 i_mem_rem = 0
1127 ENDIF
1128C
1129 ENDDO
1130C
1131 DEALLOCATE(inod2lin,tagsecnd,nod2lin)
1132 iremnode = 0
1133C
1134 ENDIF
1135
1136 CALL i11buc_vox1(
1137 1 x ,intbuf_tab(nin)%IRECTS ,intbuf_tab(nin)%IRECTM ,nrts ,nmn,
1138 2 nrtm ,nsn ,intbuf_tab(nin)%CAND_E ,intbuf_tab(nin)%CAND_N ,intbuf_tab(nin)%VARIABLES(2),
1139 3 noint ,i_stok ,intbuf_tab(nin)%VARIABLES(8) ,maxbox ,minbox,
1140 4 ncont ,multimp, intbuf_tab(nin)%MSR,
1141 5 intbuf_tab(nin)%ADCCM,intbuf_tab(nin)%CHAIN,itab,intbuf_tab(nin)%NSV,
1142 6 0, i_mem ,id,titr ,iddlevel,intbuf_tab(nin)%VARIABLES(4),
1143 7 drad, intercep,igap,intbuf_tab(nin)%GAP_S,intbuf_tab(nin)%GAP_M,
1144 8 intbuf_tab(nin)%GAP_SL,intbuf_tab(nin)%GAP_ML ,intbuf_tab(nin)%VARIABLES(13),ipari(63,nin),intbuf_tab(nin)%KREMNODE,
1145 3 intbuf_tab(nin)%REMNODE,intbuf_tab(nin)%VARIABLES(46))
1146C
1147 intbuf_tab(nin)%VARIABLES(5) = 0
1148C
1149 IF (i_mem == 2 ) RETURN
1150 intbuf_tab(nin)%VARIABLES(9) = maxbox
1151 intbuf_tab(nin)%VARIABLES(12) = minbox
1152C
1153
1154 ! -----------------
1155 ! update the weight of candidate's pair for the domain decomposition
1156 IF (iddlevel==0.AND.nspmd>1)THEN
1157 IF ( ((nelemint+i_stok)) > inter_cand%S_IXINT_2) CALL upgrade_ixint(inter_cand,nelemint,i_stok)
1158 CALL update_weight_inter_type11(nelemint,nin,nrts,nrtm,ifiend,
1159 . intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%IRECTS,i_stok,intbuf_tab(nin)%CAND_E,intbuf_tab(nin)%CAND_N,
1160 . inter_cand)
1161 ENDIF
1162 ! -----------------
1163
1164 IF((iddlevel == 0) .AND. (dectyp >= 3 .AND. dectyp <= 6))THEN
1165C node weights and interfaces
1166 CALL iwcontdd(intbuf_tab(nin)%NSV,intbuf_tab(nin)%MSR,nsn,nmn,iwcont,
1167 . nsnt,nmnt)
1168 END IF
1169C
1170C INITIAL PENETRATION CALCULATED WITH I11PEN3
1171C
1172 ngrous=1+(i_stok-1)/nvsiz
1173C
1174 IF(ipri>=1) WRITE(iout,2011)
1175C
1176
1177 print_warning = .true.
1178 DO ng=1,ngrous
1179 nft = (ng-1) * nvsiz
1180 lft = 1
1181 llt = min0( nvsiz, i_stok - nft )
1182 jlt_new = 0
1183 CALL i11dst3(
1184 1 llt ,intbuf_tab(nin)%VARIABLES(13),intbuf_tab(nin)%CAND_N(1+nft),intbuf_tab(nin)%CAND_E(1+nft),intbuf_tab(nin)%IRECTS,
1185 2 intbuf_tab(nin)%IRECTM,nx ,ny ,nz ,
1186 4 n1 ,n2 ,m1 ,m2 ,jlt_new ,
1187 5 x ,igap ,intbuf_tab(nin)%GAP_S ,intbuf_tab(nin)%GAP_M,gapv,
1188 6 intbuf_tab(nin)%GAP_SL,intbuf_tab(nin)%GAP_ML,drad ,intbuf_tab(nin)%VARIABLES(46))
1189 llt = jlt_new
1190C
1191 CALL i11pwr3(itab ,inacti,intbuf_tab(nin)%CAND_E(1+nft),intbuf_tab(nin)%CAND_N(1+nft),
1192 2 intbuf_tab(nin)%STFS,intbuf_tab(nin)%STFM,x ,intbuf_tab(nin)%NSV,iwpene ,
1193 3 n1 ,n2 ,m1 ,m2 ,nx ,
1194 4 ny ,nz ,gapv ,intbuf_tab(nin)%GAP_S,intbuf_tab(nin)%GAP_M,
1195 5 intbuf_tab(nin)%PENIS,intbuf_tab(nin)%PENIM,igap,print_warning)
1196 IF(iwpene/=0 .AND. inacti==3 .OR. inacti==4) iwrn = 1
1197
1198 ENDDO
1199 IF((iddlevel == 0) .AND. (dectyp >= 3 .AND. dectyp <= 6))THEN
1200C node weights and interfaces
1201 CALL iwcontdd(intbuf_tab(nin)%NSV,intbuf_tab(nin)%MSR,nsn,nmn,iwcont,
1202 . nsnt,nmnt)
1203 END IF
1204C-----------------------------------------------------------------------
1205 ELSEIF(nty==12) THEN
1206C-----------------------------------------------------------------------
1207 itied=int(intbuf_tab(nin)%VARIABLES(1))
1208 IF(int(intbuf_tab(nin)%VARIABLES(1))==2)
1209 . CALL in12r(x,intbuf_tab(nin)%VARIABLES(1),intbuf_tab(nin)%NSV,nsn,1)
1210
1211 !flushed between 2 domain decomposition
1212 intbuf_tab(nin)%LMSR(1:nmt) = 0
1213 CALL inint0(
1214 1 x,intbuf_tab(nin)%IRECTM, intbuf_tab(nin)%NSEGM,intbuf_tab(nin)%LMSR ,intbuf_tab(nin)%MSR,
1215 2 intbuf_tab(nin)%NSV,intbuf_tab(nin)%ILOCS,nsn ,nmn ,nrtm ,intbuf_tab(nin)%S_IRECTM ,
1216 3 intbuf_tab(nin)%S_LMSR)
1217 ipari(30,nin)=-1
1218 CALL i12chk3(x,intbuf_tab(nin)%IRECTM,ixs ,nrtm ,ixc ,
1219 1 -nin,nmn ,intbuf_tab(nin)%MSR,noint ,mwa ,
1220 2 ixtg,pm,intbuf_tab(nin)%IELEM, ale_connectivity,
1221 3 ipari(30,nin),intbuf_tab(nin)%FCOUNT,itied, itab,knod2els,
1222 4 nod2els,nty,id,titr)
1223 CALL i12chk3(x,intbuf_tab(nin)%IRECTS,ixs ,nrts ,ixc,
1224 1 nin,nsn ,intbuf_tab(nin)%NSV,noint ,mwa,
1225 2 ixtg,pm,intbuf_tab(nin)%IELES, ale_connectivity,
1226 3 ipari(30,nin),intbuf_tab(nin)%FCOUNT,itied, itab,knod2els,
1227 4 nod2els,nty,id,titr)
1228 IF(ipari(30,nin)==0)THEN
1229 CALL ancmsg(msgid=1250,msgtype=msgwarning,anmode=aninfo_blind,i1=id,c1=titr)
1230
1231 ELSEIF(itied==3)THEN
1232 ipari(30,nin)=0
1233 ENDIF
1234 CALL invoi3(
1235 1 x,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%LMSR,intbuf_tab(nin)%MSR,intbuf_tab(nin)%NSV,
1236 2 intbuf_tab(nin)%ILOCS,intbuf_tab(nin)%IRTLM,intbuf_tab(nin)%NSEGM,nsn ,nmn ,
1237 3 itab,id,titr,nrtm)
1238 WRITE(iout,2002)
1239 CALL i12tid3(
1240 1 x,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%CSTS,intbuf_tab(nin)%MSR,intbuf_tab(nin)%NSV ,
1241 2 intbuf_tab(nin)%ILOCS,intbuf_tab(nin)%IRTLM,nsn ,itab ,intbuf_tab(nin)%VARIABLES(2),
1242 3 id,titr)
1243 IF(int(intbuf_tab(nin)%VARIABLES(1))==2)
1244 . CALL in12r(x,intbuf_tab(nin)%VARIABLES(1),intbuf_tab(nin)%NSV,nsn,2)
1245C
1246C-----------------------------------------------------------------------
1247 ELSEIF(nty == 17 .AND. ipari(33,nin) == 0) THEN
1248C-----------------------------------------------------------------------
1249 ign = ipari(36,nin)
1250 ige = ipari(34,nin)
1251 nmes = igrbric(ign)%NENTITY
1252 nme = igrbric(ige)%NENTITY
1253C
1254C ELMENTARY STIFFNESS
1255C
1256 CALL i17sti3(
1257 1 ixs ,pm ,nme ,nmes ,igrbric(ige)%ENTITY,igrbric(ign)%ENTITY,
1258 2 intbuf_tab(nin)%KM,intbuf_tab(nin)%KS)
1259C-----------------------------------------------------------------------
1260 ELSEIF(nty==20) THEN
1261C-----------------------------------------------------------------------
1262 CALL i20ini3(x ,ixs ,ixc ,
1263 2 pm ,geo ,ipari(1,nin) ,nin ,itab ,
1264 3 ms ,mwa ,rwa ,ixtg ,iwrn ,
1265 4 ikine ,ixt ,ixp ,ixr ,nelemint,
1266 5 iddlevel,ifiend ,nsnet ,
1267 6 nmnet ,iwcont ,nsnt ,
1268 7 nmnt ,knod2els,knod2elc,knod2eltg,nod2els,
1269 8 nod2elc ,nod2eltg,igrsurf ,ikine1 ,ipart ,
1270 9 ipartc ,iparttg ,thk ,thk_part,inpene ,
1271 a iwpene ,ixs10,i_mem ,
1272 b inter_cand,ixs16 ,ixs20 ,id ,titr ,
1273 c kxx ,ixx ,igeo ,nod2el1d,knod2el1d,
1274 d lelx ,intbuf_tab(nin) , stack%pm , iworksh,nspmd)
1275 IF (i_mem ==2) RETURN
1276C-----------------------------------------------------------------------
1277 ELSEIF(nty==21) THEN
1278C-----------------------------------------------------------------------
1279 !must be flushed to 0 (in old code INBUF and BUFIN
1280 !flushed between 2 domain decomposition)
1281 intbuf_tab(nin)%AREAS(1:nsn) = 0
1282 IF(intth/=0)THEN
1283 intbuf_tab(nin)%AS(1:nsn) = 0
1284 intbuf_tab(nin)%BS(1:nsn) = 0
1285 ENDIF
1286
1287C check segments with zero area
1288 CALL i7err3(
1289 1 x ,nrtm ,intbuf_tab(nin)%IRECTM ,noint ,itab,id,titr,
1290 2 ix1 ,ix2 ,ix3 ,ix4 ,x1 ,
1291 3 x2 ,x3 ,x4 ,y1 ,y2 ,
1292 4 y3 ,y4 ,z1 ,z2 ,z3 ,
1293 5 z4 ,n11 ,n21 ,n31 ,x0 ,
1294 6 y0 ,z0 ,xn1 ,yn1 ,zn1 ,
1295 7 xn2 ,yn2 ,zn2 ,xn3 ,yn3 ,
1296 8 zn3 ,xn4 ,yn4 ,zn4 )
1297C
1298C SEARCHING FOR SECOND ELEMENTS and CHECK MAIN ELEMENTS C + Heat pre-treatment
1299C
1300 CALL i21els3(
1301 1 x ,intbuf_tab(nin)%IRECTS,intbuf_tab(nin)%IRECTM ,nrts ,nrtm ,
1302 2 geo ,ixs ,pm ,ixc ,ixtg ,
1303 3 -nin ,nty ,noint ,nsn ,intbuf_tab(nin)%NSV ,
1304 4 intbuf_tab(nin)%IELES,ipari(47,nin) ,intbuf_tab(nin)%AREAS,nmn ,intbuf_tab(nin)%MSR,
1305 5 knod2els ,knod2elc ,knod2eltg ,nod2els ,nod2elc ,
1306 6 nod2eltg ,igrsurf(isu1),igrsurf(isu2),ielem21 ,
1307 7 thk ,intbuf_tab(nin)%AS,intbuf_tab(nin)%BS,ixs10 ,ixs16 ,
1308 8 ixs20 ,id,titr,igeo,sh4tree ,
1309 9 sh3tree ,ipart ,ipartc ,iparttg , stack%pm ,
1310 a iworksh ,ipari(72,nin) ,tagprt_fric , intbuf_tab(nin)%IPARTFRICS,
1311 g intbuf_tab(nin)%IPARTFRICM,intbuf_fric_tab,iparts)
1312C
1313C ...GAP CALCULATION AND INITIAL PENETRATIONS after INITIA subroutine (thickness must be read).
1314C
1315C-----------------------------------------------------------------------
1316 ELSEIF(nty==22) THEN
1317C-----------------------------------------------------------------------
1318C checking cmaterial compatibility
1319 IF(isu1>0)THEN
1320 CALL i22err3(
1321 1 x ,nrtm ,intbuf_tab(nin)%IRECTM ,itab ,
1322 2 pm ,ixs ,igrbric(isu1)%NENTITY ,igrbric(isu1)%ENTITY ,id ,
1323 3 titr,
1324 4 ix1 ,ix2 ,ix3 ,ix4 ,x1 ,
1325 5 x2 ,x3 ,x4 ,y1 ,y2 ,
1326 6 y3 ,y4 ,z1 ,z2 ,z3 ,
1327 7 z4 ,n11 ,n21 ,n31 ,x0 ,
1328 8 y0 ,z0 ,xn1 ,yn1 ,zn1 ,
1329 9 xn2 ,yn2 ,zn2 ,xn3 ,yn3 ,
1330 1 zn3 ,xn4 ,yn4 ,zn4 )
1331 ENDIF
1332
1333C
1334C NODAL AND ELEMENTARY STIFFNESS
1335C
1336 CALL i22sti3(intbuf_tab(nin)%STFM, nrtm )
1337
1338 ipari(21,nin) = igap
1339 iad = ipari(39,nin)
1340 isu1 = ipari(45,nin)
1341 IF(isu1>0)THEN
1342 nbric = igrbric(isu1)%NENTITY
1343 ELSE
1344 nbric = 0
1345 ENDIF
1346
1347 iad=max(iad,1) !in case of ISU1=0 (empty group => normal termination with error message)
1348
1349 CALL i22tzinf( x ,intbuf_tab(nin)%VARIABLES(8) ,igrbric(isu1)%ENTITY ,nbric ,ixs )
1350C-----------------------------------------------------------------------
1351 ELSEIF(nty==23) THEN
1352C-----------------------------------------------------------
1353C detects segments with null area
1354 CALL i7err3(
1355 1 x ,nrtm ,intbuf_tab(nin)%IRECTM ,noint ,itab,id,titr,
1356 2 ix1 ,ix2 ,ix3 ,ix4 ,x1 ,
1357 3 x2 ,x3 ,x4 ,y1 ,y2 ,
1358 4 y3 ,y4 ,z1 ,z2 ,z3 ,
1359 5 z4 ,n11 ,n21 ,n31 ,x0 ,
1360 6 y0 ,z0 ,xn1 ,yn1 ,zn1 ,
1361 7 xn2 ,yn2 ,zn2 ,xn3 ,yn3 ,
1362 8 zn3 ,xn4 ,yn4 ,zn4 )
1363C
1364C GAP CALCULATION / SEARCHING SECOND ELEMENTS and CHECK MAIN ELEMENTS C
1365 CALL i23gap3(
1366 1 x ,intbuf_tab(nin)%IRECTS,intbuf_tab(nin)%IRECTM ,nrts ,nrtm ,
1367 2 geo ,ixs ,pm ,ixc ,ixtg ,
1368 3 -nin ,nty ,noint ,nsn ,intbuf_tab(nin)%NSV ,
1369 4 ipari(47,nin) ,nmn ,intbuf_tab(nin)%MSR,rwa ,
1370 5 knod2els ,knod2elc ,knod2eltg ,nod2els ,nod2elc ,
1371 6 nod2eltg ,thk ,ixs10 ,ixs16 ,ixs20 ,
1372 7 ipartc ,iparttg ,intbuf_tab(nin)%VARIABLES(2),igap,intbuf_tab(nin)%GAP_S,
1373 8 intbuf_tab(nin)%VARIABLES(13),intbuf_tab(nin)%VARIABLES(6),intbuf_tab(nin)%VARIABLES(16),
1374 . intbuf_tab(nin)%VARIABLES(19),intbuf_tab(nin)%VARIABLES(7),
1375 9 intbuf_tab(nin)%STFNS,intbuf_tab(nin)%STFM,id,titr,intbuf_tab(nin)%GAP_M, igeo ,
1376 a stack%pm , iworksh)
1377C
1378C STILL ONE BUCKET SORT
1379C
1380 maxbox = intbuf_tab(nin)%VARIABLES(9)
1381 minbox = intbuf_tab(nin)%VARIABLES(12)
1382 CALL i23buc1(
1383 1 x ,intbuf_tab(nin)%IRECTM ,intbuf_tab(nin)%NSV,intbuf_tab(nin)%VARIABLES(4),nseg ,
1384 2 nmn ,nrtm ,mwa ,nsn ,intbuf_tab(nin)%CAND_E ,
1385 3 intbuf_tab(nin)%CAND_N ,intbuf_tab(nin)%VARIABLES(2),rwa ,noint ,i_stok ,
1386 4 intbuf_tab(nin)%VARIABLES(5),intbuf_tab(nin)%VARIABLES(8),maxbox ,minbox ,intbuf_tab(nin)%MSR ,
1387 5 intbuf_tab(nin)%STFM ,multimp ,itab ,intbuf_tab(nin)%GAP_S ,igap ,
1388 6 intbuf_tab(nin)%VARIABLES(13),intbuf_tab(nin)%VARIABLES(16) ,inacti ,nrts ,intbuf_tab(nin)%IRECTS,
1389 7 i_mem ,iddlevel,id,titr,intbuf_tab(nin)%GAP_M,
1390 8 prov_n,prov_e ,ix1,ix2,
1391 9 ix3 ,ix4 ,nsvg ,x1 ,x2 ,
1392 1 x3 ,x4 ,y1 ,y2 ,y3 ,
1393 2 y4 ,z1 ,z2 ,z3 ,z4 ,
1394 3 xi ,yi ,zi ,x0 ,y0 ,
1395 4 z0 ,xn1 ,yn1 ,zn1,xn2,
1396 5 yn2 ,zn2 ,xn3 ,yn3,zn3,
1397 6 xn4 ,yn4 ,zn4 ,p1 ,p2 ,
1398 7 p3 ,p4 ,lb1 ,lb2,lb3,
1399 8 lb4 ,lc1 ,lc2 ,lc3,lc4,
1400 9 n11 ,n21 ,n31 ,pene )
1401 IF (i_mem == 2 ) RETURN
1402 intbuf_tab(nin)%VARIABLES(9) = maxbox
1403 intbuf_tab(nin)%VARIABLES(12) = minbox
1404
1405 ! -----------------
1406 ! update the weight of candidate's pair for the domain decomposition
1407 IF (iddlevel==0.AND.nspmd>1)THEN
1408 IF ( ((nelemint+i_stok)) > inter_cand%S_IXINT_2) CALL upgrade_ixint(inter_cand,nelemint,i_stok)
1409
1410 gap = intbuf_tab(nin)%VARIABLES(2)
1411 gapmin = intbuf_tab(nin)%VARIABLES(13)
1412 gapmax = intbuf_tab(nin)%VARIABLES(16)
1413 dgapload = intbuf_tab(nin)%VARIABLES(46)
1414 CALL update_weight_inter_type7(nelemint,nin,nsn,nrtm,ifiend,
1415 . intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,i_stok,intbuf_tab(nin)%CAND_E,intbuf_tab(nin)%CAND_N,
1416 . igap,gap,gapmax,gapmin,dgapload,
1417 . drad,intbuf_tab(nin)%GAP_S,intbuf_tab(nin)%GAP_SL,intbuf_tab(nin)%GAP_M,intbuf_tab(nin)%GAP_ML,
1418 . numnod,x,inter_cand)
1419 ENDIF
1420 ! -----------------
1421
1422 IF((iddlevel==0).AND. (dectyp>=3.AND.dectyp<=6))THEN
1423C node weights and interfaces
1424 CALL iwcontdd(intbuf_tab(nin)%NSV,intbuf_tab(nin)%MSR,nsn,nmn,iwcont,
1425 . nsnt,nmnt)
1426 END IF
1427
1428C INITIAL PENETRATIONS CALCULATED WITH I23DST3
1429
1430 ngrous=1+(i_stok-1)/nvsiz
1431
1432 DO ng=1,ngrous
1433
1434 IF(ipri>=1) WRITE(iout,2007)
1435 nft = (ng-1) * nvsiz
1436 lft = 1
1437 llt = min0( nvsiz, i_stok - nft )
1438 CALL i23dst3(
1439 1 llt ,intbuf_tab(nin)%CAND_N(1+nft),intbuf_tab(nin)%CAND_E(1+nft),intbuf_tab(nin)%IRECTM,
1440 . intbuf_tab(nin)%NSV ,
1441 2 intbuf_tab(nin)%GAP_S,x ,intbuf_tab(nin)%MSR,pene,intbuf_tab(nin)%IFPEN(1+nft) ,
1442 3 igap ,intbuf_tab(nin)%VARIABLES(2), intbuf_tab(nin)%VARIABLES(16),
1443 . intbuf_tab(nin)%VARIABLES(13), gapv,
1444 4 intbuf_tab(nin)%GAP_M)
1445
1446 CALL i23pwr3(
1447 . itab ,inacti,intbuf_tab(nin)%CAND_E(1+nft),intbuf_tab(nin)%CAND_N(1+nft),
1448 . intbuf_tab(nin)%STFNS,
1449 1 x ,llt ,intbuf_tab(nin)%NSV,iwpene ,pene ,
1450 2 noint ,nty ,intbuf_tab(nin)%GAP_S,intbuf_tab(nin)%MSR,
1451 3 intbuf_tab(nin)%IRECTM ,intbuf_tab(nin)%VARIABLES(13),intbuf_tab(nin)%VARIABLES(16),
1452 . intbuf_tab(nin)%VARIABLES(27),
1453 4 nsn ,mwa ,intbuf_tab(nin)%CAND_E,intbuf_tab(nin)%CAND_N,
1454 5 intbuf_tab(nin)%CAND_P,intbuf_tab(nin)%STFM,intbuf_tab(nin)%IFPEN(1+nft),intbuf_tab(nin)%IFPEN,gapv )
1455
1456 END DO !next NG
1457
1458 IF(iwpene/=0) THEN
1459 CALL ancmsg(msgid=499,msgtype=msgwarning,anmode=aninfo_blind_1,i1=id,c1=titr,i2=iwpene)
1460 ENDIF
1461
1462 IF(iwpene==0.AND.(inacti==5.OR.inacti==6)) ipari(22,nin) = -inacti ! negative transition for sizing
1463 intbuf_tab(nin)%I_STOK(1)=iwpene
1464C
1465C ...GAP CALCULATION AND INITIAL PENETRATIONS after INITIA subroutine (thickness must be read).
1466C
1467C-----------------------------------------------------------------------
1468 ELSEIF(nty==24) THEN
1469C-----------------------------------------------------------------------
1470 ipen0 = ipari(54,nin)
1471 nrtse = ipari(52,nin)
1472 nsne = ipari(55,nin)
1473 igsti = ipari(34,nin)
1474 nrtm0=nrtm-nrtm_sh
1475 nsn0=nsn-nsne
1476 intbuf_tab(nin)%MVOISIN(1:4*nrtm)=0
1477 CALL i7err3(
1478 1 x ,nrtm ,intbuf_tab(nin)%IRECTM ,noint ,itab,id,titr,
1479 2 ix1 ,ix2 ,ix3 ,ix4 ,x1 ,
1480 3 x2 ,x3 ,x4 ,y1 ,y2 ,
1481 4 y3 ,y4 ,z1 ,z2 ,z3 ,
1482 5 z4 ,n11 ,n21 ,n31 ,x0 ,
1483 6 y0 ,z0 ,xn1 ,yn1 ,zn1 ,
1484 7 xn2 ,yn2 ,zn2 ,xn3 ,yn3 ,
1485 8 zn3 ,xn4 ,yn4 ,zn4 )
1486C
1487C NODAL AND ELEMENTARY STIFFNESS
1488C---- INTBUF_TAB(NIN)%CRIT V/A is used temporarily for sorting and Pen-max
1489 ALLOCATE(ipartns(nsn))
1490 ipartns(1:nsn)=0
1491 CALL i24sti3(
1492 1 x ,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%STFM ,ixs ,pm ,
1493 2 geo ,nrtm0 ,ixc ,-nin ,intbuf_tab(nin)%STFAC(1),
1494 3 nty ,intbuf_tab(nin)%VARIABLES(2),noint ,
1495 4 intbuf_tab(nin)%STFNS,nsn0 ,ms ,intbuf_tab(nin)%NSV,ixtg ,
1496 5 igap ,rwa ,intbuf_tab(nin)%GAP_S,intbuf_tab(nin)%GAP_M,intbuf_tab(nin)%VARIABLES(13),
1497 6 ixt ,ixp ,intbuf_tab(nin)%VARIABLES(6),intbuf_tab(nin)%VARIABLES(35),
1498 9 inacti ,knod2els ,knod2elc ,knod2eltg ,nod2els ,
1499 a nod2elc ,nod2eltg ,igrsurf(max(1,isu2)),ipari(47,nin) ,
1500 b intbuf_tab(nin)%IELES,intbuf_tab(nin)%IELEC, intbuf_tab(nin)%AREAS ,sh4tree ,sh3tree,
1501 c ipart ,ipartc ,iparttg ,thk ,thk_part,
1502 d ixr ,itab ,intbuf_tab(nin)%VARIABLES(7),ixs10 ,intbuf_tab(nin)%MSEGTYP24 ,
1503 e nrtm_sh ,ixs16 ,ixs20 ,intbuf_tab(nin)%GAP_NM,intbuf_tab(nin)%MVOISIN ,
1504 f ilev ,igrsurf(max(1,isu1)),intbuf_tab(nin)%VARIABLES(36),id,titr ,ipari(53,nin) ,
1505 g intbuf_tab(nin)%PENE_OLD ,ipartns ,iparts , igeo ,fillsol ,
1506 h stack%pm ,iworksh ,ipari(72,nin) ,tagprt_fric , intbuf_tab(nin)%IPARTFRICS,
1507 g intbuf_tab(nin)%IPARTFRICM,intbuf_fric_tab,ipari(86,nin) , nrts ,intbuf_tab(nin)%IRECTS ,
1508 i intbuf_tab(nin)%IELNRTS,intbuf_tab(nin)%ADRECTS,intbuf_tab(nin)%FACNRTS,nmn,intbuf_tab(nin)%MSR ,
1509 j ipartt ,ipartp ,ipartr ,elem_linked_to_segment,igsti, flag_elem_inter25 )
1510 ipari(21,nin) = igap
1511C---------GAP_S for fictive nodes
1512 IF (nsne >0) THEN
1513 CALL i24fics_ini(intbuf_tab(nin)%IRTSE ,nsne ,intbuf_tab(nin)%IS2SE ,intbuf_tab(nin)%NSV ,
1514 1 intbuf_tab(nin)%IS2PT ,nsn ,intbuf_tab(nin)%GAP_S )
1515 CALL i24fics_ini(intbuf_tab(nin)%IRTSE ,nsne ,intbuf_tab(nin)%IS2SE ,intbuf_tab(nin)%NSV ,
1516 1 intbuf_tab(nin)%IS2PT ,nsn ,intbuf_tab(nin)%STFNS )
1517 CALL i24fici_ini(intbuf_tab(nin)%IRTSE ,nsne ,intbuf_tab(nin)%IS2SE ,intbuf_tab(nin)%NSV ,
1518 1 intbuf_tab(nin)%IS2PT ,nsn ,ipartns )
1519 CALL i24isegpt_ini(intbuf_tab(nin)%IRTSE ,nsne ,intbuf_tab(nin)%IS2SE ,intbuf_tab(nin)%NSV ,
1520 1 intbuf_tab(nin)%IS2PT ,nsn ,intbuf_tab(nin)%ISEGPT,3 ,intbuf_tab(nin)%ISPT2)
1521C---------second normal (nodal)------------------
1522 CALL i24ficv_ini(intbuf_tab(nin)%IRTSE ,nsne ,intbuf_tab(nin)%IS2SE ,intbuf_tab(nin)%NSV ,
1523 1 intbuf_tab(nin)%IS2PT ,nsn ,intbuf_tab(nin)%PENE_OLD,3 )
1524 CALL i24fici_ini(intbuf_tab(nin)%IRTSE ,nsne ,intbuf_tab(nin)%IS2SE ,intbuf_tab(nin)%NSV ,
1525 1 intbuf_tab(nin)%IS2PT ,nsn ,intbuf_tab(nin)%NBINFLG )
1526 END IF
1527
1528C INITIALIZE NODAL SECOND,MAIN LENGTH FOR [K]geo(implicit)
1529C------------------
1530 IF(intkg > 0 ) THEN
1531 CALL i24ll_kg(
1532 1 x ,intbuf_tab(nin)%IRECTM,ixs ,pm ,rwa ,
1533 2 geo ,nrtm0 ,ixc ,-nin ,nty ,
1534 3 noint ,nsn0 ,intbuf_tab(nin)%NSV,ixtg ,ixt ,
1535 4 ixp ,ipart ,ipartc ,iparttg ,thk ,
1536 d thk_part ,ixr ,itab ,ixs10 ,ixs16 ,
1537 e ixs20 ,nmn ,intbuf_tab(nin)%MSR,intbuf_tab(nin)%NOD_2RY_LGTH,
1538 f intbuf_tab(nin)%NOD_MAS_LGTH,ipartt,ipartp,ipartr ,igeo )
1539 CALL i24fics_ini(intbuf_tab(nin)%IRTSE ,nsne ,intbuf_tab(nin)%IS2SE ,intbuf_tab(nin)%NSV ,
1540 1 intbuf_tab(nin)%IS2PT ,nsn ,intbuf_tab(nin)%NOD_2RY_LGTH )
1541 END IF
1542C STILL ONE BUCKET SORT
1543C
1544 maxbox = intbuf_tab(nin)%VARIABLES(9)
1545 minbox = intbuf_tab(nin)%VARIABLES(12)
1546 penmax = intbuf_tab(nin)%VARIABLES(37)
1547
1548
1549C ====================================================================
1550C The following commented code flushes input for the hypmersh library
1551C It is used to test the library
1552C FILNAM='input24.dat'
1553C OPEN(UNIT=67,FILE=FILNAM,ACCESS='SEQUENTIAL',
1554C . FORM='FORMATTED',STATUS='UNKNOWN')
1555C IF(IDDLEVEL==1) CALL IO_TYPE24(0,67,
1556C . IGAP,
1557C . IPEN0,
1558C . I_STOK,
1559C . INACTI,
1560C . MULTIMP,
1561C . NMN,
1562C . NRTM,
1563C . NRTM0,
1564C . NRTM_SH,
1565C . NRTSE,
1566C . NSN,
1567C . NSN0,
1568C . NSNE,
1569C . NUMELS,
1570C . NUMELS8,
1571C . NUMELS10,
1572C . NUMELS16,
1573C . NUMELS20,
1574C . NUMNOD ,
1575C . INTBUF_TAB(NIN)%I_STOK,
1576C . INTBUF_TAB(NIN)%ICONT_I,
1577C . IPARTNS,
1578C . INTBUF_TAB(NIN)%IRECTM,
1579C . INTBUF_TAB(NIN)%IRTLM,
1580C . INTBUF_TAB(NIN)%IRTSE,
1581C . INTBUF_TAB(NIN)%IS2SE,
1582C . INTBUF_TAB(NIN)%IS2PT,
1583C . ITAB ,
1584C . INTBUF_TAB(NIN)%MBINFLG,
1585C . INTBUF_TAB(NIN)%MSEGTYP24,
1586C . INTBUF_TAB(NIN)%MSR,
1587C . MWA,
1588C . INTBUF_TAB(NIN)%NBINFLG,
1589C . NOD2ELS,
1590C . KNOD2ELS,
1591C . NSEG,
1592C . INTBUF_TAB(NIN)%NSV,
1593C . IXS,
1594C . IXS10,
1595C . IXS16,
1596C . IXS20 ,
1597C . INTBUF_TAB(NIN)%MVOISIN,
1598C . INTBUF_TAB(NIN)%VARIABLES,
1599C . X,
1600C . INTBUF_TAB(NIN)%CAND_E,
1601C . INTBUF_TAB(NIN)%CAND_N,
1602C . INTBUF_TAB(NIN)%GAP_M,
1603C . INTBUF_TAB(NIN)%GAP_NM,
1604C . INTBUF_TAB(NIN)%GAP_S,
1605C . INTBUF_TAB(NIN)%PENE_OLD,
1606C . PENMIN,
1607C . INTBUF_TAB(NIN)%STFM ,
1608C . INTBUF_TAB(NIN)%STFNS,
1609C . INTBUF_TAB(NIN)%STIF_OLD,
1610C . INTBUF_TAB(NIN)%XFIC,
1611C . RWA)
1612C CLOSE(67)
1613
1614 CALL i24buc1(
1615 1 x ,intbuf_tab(nin)%IRECTM ,intbuf_tab(nin)%NSV,intbuf_tab(nin)%VARIABLES(4),nseg ,
1616 2 nmn ,nrtm ,mwa ,nsn ,intbuf_tab(nin)%CAND_E ,
1617 3 intbuf_tab(nin)%CAND_N ,intbuf_tab(nin)%VARIABLES(2),rwa ,noint ,i_stok ,
1618 4 intbuf_tab(nin)%VARIABLES(5),intbuf_tab(nin)%VARIABLES(8),maxbox ,minbox,intbuf_tab(nin)%MSR,
1619 5 intbuf_tab(nin)%STFM ,intbuf_tab(nin)%STFNS ,multimp ,1 ,iddlevel ,
1620 6 itab ,intbuf_tab(nin)%GAP_S,intbuf_tab(nin)%GAP_M,igap,intbuf_tab(nin)%VARIABLES(13),
1621 7 intbuf_tab(nin)%VARIABLES(16),inacti ,intbuf_tab(nin)%STIF_OLD,intbuf_tab(nin)%PENE_OLD,i_mem ,
1622 8 intbuf_tab(nin)%VARIABLES(25),id ,titr ,intbuf_tab(nin)%NBINFLG ,intbuf_tab(nin)%MBINFLG,
1623 9 ilev ,intbuf_tab(nin)%MSEGTYP24,intbuf_tab(nin)%GAP_NM,intbuf_tab(nin)%MVOISIN,ixs ,ixs10 ,
1624 a ixs16 ,ixs20 ,ipartns ,ipen0,penmax,intbuf_tab(nin)%IRTSE,
1625 b intbuf_tab(nin)%IS2SE,intbuf_tab(nin)%IS2PT,intbuf_tab(nin)%XFIC,nrtse ,nsne ,prov_n ,prov_e,nsvg ,
1626 1 ix1 ,ix2 ,ix3 ,ix4 ,x1 ,
1627 2 x2 ,x3 ,x4 ,y1 ,y2 ,
1628 3 y3 ,y4 ,z1 ,z2 ,z3 ,
1629 4 z4 ,xi ,yi ,zi ,x0 ,
1630 5 y0 ,z0 ,stif ,pene ,xn1 ,
1631 6 yn1 ,zn1 ,xn2 ,yn2 ,zn2 ,
1632 7 xn3 ,yn3 ,zn3 ,xn4 ,yn4 ,
1633 8 zn4 ,p1 ,p2 ,p3 ,p4 ,
1634 9 lb1 ,lb2 ,lb3 ,lb4 ,lc1 ,
1635 1 lc2 ,lc3 ,lc4 ,n11 ,n21 ,
1636 2 n31 ,intbuf_tab(nin)%VARIABLES(46),intbuf_tab(nin)%S_KREMNODE,intbuf_tab(nin)%S_REMNODE,
1637 3 intbuf_tab(nin)%KREMNODE,intbuf_tab(nin)%REMNODE,flag_removed_node)
1638 IF (i_mem == 2) RETURN
1639 intbuf_tab(nin)%VARIABLES(9) = maxbox
1640 intbuf_tab(nin)%VARIABLES(12) = minbox
1641
1642 ! -----------------
1643 ! update the weight of candidate's pair for the domain decomposition
1644 IF (iddlevel==0.AND.nspmd>1)THEN
1645 IF ( ((nelemint+i_stok)) > inter_cand%S_IXINT_2) CALL upgrade_ixint(inter_cand,nelemint,i_stok)
1646
1647 dgapload = intbuf_tab(nin)%VARIABLES(46)
1648 kind_inter = 24
1649 CALL update_weight_inter_type_24_25(numnod,nelemint,nin,nsn,nrtm,
1650 . ifiend,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,i_stok,intbuf_tab(nin)%CAND_E,
1651 . intbuf_tab(nin)%CAND_N,dgapload,intbuf_tab(nin)%GAP_S,intbuf_tab(nin)%GAP_M,x,inter_cand,
1652 . kind_inter,intbuf_tab(nin),iedge,nledge)
1653 ENDIF
1654 ! -----------------
1655
1656 IF((iddlevel==0).AND.
1657 . (dectyp>=3.AND.dectyp<=6))THEN
1658C nodal weights and interfaces
1659 CALL iwcontdd_type24(numnod,nsn,nmn,intbuf_tab(nin)%NSV,intbuf_tab(nin)%MSR,
1660 . iwcont,nsnt,nmnt,intbuf_tab(nin))
1661 END IF
1662C
1663C-------COMPUTE INITIAL PENETRATION LIKE type5 does for solid
1664C
1665 ngrous=1+(i_stok-1)/nvsiz
1666 IF (ngrous>0) THEN
1667C initialise IRTLM(2,NSN)=0 and after in I24PEN3,
1668 DO i=1,2*nsn
1669 intbuf_tab(nin)%IRTLM(i)=0
1670 END DO
1671C---------PENE_OLD(5,NI)=ZERO
1672 DO i=1,nsn
1673 intbuf_tab(nin)%PENE_OLD(1+5*(i-1)+4)=zero
1674 END DO
1675 ALLOCATE(penmin(nsn))
1676 penmin=ep10
1677 iwpene0 = 0
1678 DO ng=1,ngrous
1679 IF(ipri>=5) WRITE(iout,2007)
1680 nft = (ng-1) * nvsiz
1681 lft = 1
1682 llt = min0( nvsiz, i_stok - nft )
1683 CALL i24cor3(
1684 1 x ,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,intbuf_tab(nin)%CAND_E(1+nft),intbuf_tab(nin)%CAND_N(1+nft) ,
1685 2 intbuf_tab(nin)%STFM,intbuf_tab(nin)%STFNS,gapv ,igap ,intbuf_tab(nin)%VARIABLES(2) ,
1686 3 intbuf_tab(nin)%GAP_S,intbuf_tab(nin)%GAP_M)
1687 CALL i24pen3(x ,intbuf_tab(nin)%IRECTM ,gapv ,intbuf_tab(nin)%CAND_E(1+nft),
1688 2 intbuf_tab(nin)%CAND_N(1+nft),intbuf_tab(nin)%NSV,inacti,itab,mwa,iwpene ,
1689 3 nsn ,intbuf_tab(nin)%IRTLM,intbuf_tab(nin)%MSEGTYP24,iwpene0,penmin,
1690 4 intbuf_tab(nin)%GAP_NM,intbuf_tab(nin)%MVOISIN,ixs ,ixs10 ,ixs16 ,
1691 5 ixs20,penmax,intbuf_tab(nin)%VARIABLES(38),id,titr ,
1692 6 ilev ,intbuf_tab(nin)%PENE_OLD,knod2els,nod2els,ipartns,ipen0 ,
1693 7 intbuf_tab(nin)%ICONT_I,intbuf_tab(nin)%XFIC,nrtm,intbuf_tab(nin)%IRTSE ,
1694 8 intbuf_tab(nin)%IS2SE)
1695C INTBUF_TAB(NIN)%I_STOK(1)==II_STOK
1696 intbuf_tab(nin)%I_STOK(1)=iwpene
1697 ENDDO
1698 iwpene0 = 0
1699 iwpene = 0
1700 IF (iddlevel == 1 ) THEN
1701 CALL i24pwr3(
1702 1 itab ,inacti,intbuf_tab(nin)%CAND_E,intbuf_tab(nin)%CAND_N,penmin ,
1703 1 intbuf_tab(nin)%VARIABLES(38),i_stok,intbuf_tab(nin)%NSV,iwpene ,intbuf_tab(nin)%PENE_OLD,
1704 2 noint ,nty ,intbuf_tab(nin)%MSR,intbuf_tab(nin)%IRTLM,intbuf_tab(nin)%IRECTM ,
1705 4 nsn ,id ,titr ,intbuf_tab(nin)%ICONT_I,iwpene0 )
1706C-----cancel pressfit if no initial pene
1707 IF (inacti==-1.AND.iwpene == 0) THEN
1708 ipari(40,nin) = 0
1709 CALL ancmsg(msgid=1566,msgtype=msgwarning,anmode=aninfo_blind_1,i1=id,c1=titr)
1710 END IF
1711 END IF !(IDDLEVEL == 1 ) THEN
1712C------not to repeat the same mess
1713 inpene = 0
1714
1715C The following commented code flushes input for the hypmersh library
1716C It is used to test the library
1717c FILNAM='output24.dat'
1718c OPEN(UNIT=68,FILE=FILNAM,ACCESS='SEQUENTIAL',
1719c . FORM='FORMATTED',STATUS='UNKNOWN')
1720
1721c IF(IDDLEVEL==1) CALL IO_TYPE24(0,68,
1722c . IGAP,
1723c . IPEN0,
1724c . I_STOK,
1725c . INACTI,
1726c . MULTIMP,
1727c . NMN,
1728c . NRTM,
1729c . NRTM0,
1730c . NRTM_SH,
1731c . NRTSE,
1732c . NSN,
1733c . NSN0,
1734c . NSNE,
1735c . NUMELS,
1736C . NUMELS8,
1737c . NUMELS10,
1738c . NUMELS16,
1739c . NUMELS20,
1740c . NUMNOD ,
1741c . INTBUF_TAB(NIN)%I_STOK,
1742c . INTBUF_TAB(NIN)%ICONT_I,
1743c . IPARTNS,
1744c . INTBUF_TAB(NIN)%IRECTM,
1745c . INTBUF_TAB(NIN)%IRTLM,
1746c . INTBUF_TAB(NIN)%IRTSE,
1747c . INTBUF_TAB(NIN)%IS2SE,
1748c . INTBUF_TAB(NIN)%IS2PT,
1749c . ITAB ,
1750c . INTBUF_TAB(NIN)%MBINFLG,
1751c . INTBUF_TAB(NIN)%MSEGTYP24,
1752c . INTBUF_TAB(NIN)%MSR,
1753c . MWA,
1754c . INTBUF_TAB(NIN)%NBINFLG,
1755c . NOD2ELS,
1756c . KNOD2ELS,
1757c . NSEG,
1758c . INTBUF_TAB(NIN)%NSV,
1759c . IXS,
1760c . IXS10,
1761c . IXS16,
1762c . IXS20 ,
1763c . INTBUF_TAB(NIN)%MVOISIN,
1764c . INTBUF_TAB(NIN)%VARIABLES,
1765c . X,
1766c . INTBUF_TAB(NIN)%CAND_E,
1767c . INTBUF_TAB(NIN)%CAND_N,
1768c . INTBUF_TAB(NIN)%GAP_M,
1769c . INTBUF_TAB(NIN)%GAP_NM,
1770c . INTBUF_TAB(NIN)%GAP_S,
1771c . INTBUF_TAB(NIN)%PENE_OLD,
1772c . PENMIN,
1773c . INTBUF_TAB(NIN)%STFM ,
1774c . INTBUF_TAB(NIN)%STFNS,
1775c . INTBUF_TAB(NIN)%STIF_OLD,
1776c . INTBUF_TAB(NIN)%XFIC,
1777c . RWA)
1778c CLOSE(67)
1779
1780 DEALLOCATE(penmin,ipartns)
1781 END IF !(NGROUS>0) THEN
1782 IF (inacti==5.OR.inacti==-1) THEN
1783C--- PEN_OLD(1:3,1:NSN)=ZERO
1784 pene_max = zero
1785 DO i=1,nsn
1786 intbuf_tab(nin)%PENE_OLD(5*(i-1)+1)=zero
1787 intbuf_tab(nin)%PENE_OLD(5*(i-1)+2)=zero
1788 intbuf_tab(nin)%PENE_OLD(5*(i-1)+3)=intbuf_tab(nin)%PENE_OLD(5*(i-1)+5)
1789 pene_max = max(pene_max,intbuf_tab(nin)%PENE_OLD(5*(i-1)+5))
1790 END DO
1791 intbuf_tab(nin)%VARIABLES(23) = pene_max
1792 END IF
1793 IF (nsne>0 .AND. iddlevel == 1 ) THEN
1794 facf = one*nsne/nsn
1795 WRITE(iout,2500)nsne,facf
1796 END IF
1797C-----------------------------------------------------------
1798C ELEMENT NEIGHBROUR
1799C--------------------------------------------------------
1800 CALL i24inisur_nei(
1801 1 nrtm ,nsn ,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%IRTLM,intbuf_tab(nin)%MVOISIN,
1802 2 intbuf_tab(nin)%NVOISIN,intbuf_tab(nin)%MSEGLO,intbuf_tab(nin)%MSEGTYP24,itab ,x ,
1803 3 id,titr,igeo )
1804
1805 CALL i24ini_gap_n(
1806 1 nrtm ,intbuf_tab(nin)%IRECTM,ixs ,geo ,ixc ,ixtg ,
1807 2 ixt ,ixp ,ipart ,ipartc ,iparttg ,
1808 3 thk ,thk_part,intbuf_tab(nin)%NVOISIN,intbuf_tab(nin)%GAP_NM,intbuf_tab(nin)%GAP_M,
1809 4 nmn ,intbuf_tab(nin)%MSR,intbuf_tab(nin)%GAPN_M,intbuf_tab(nin)%GAP_N0,intply,
1810 5 intbuf_tab(nin)%VARIABLES(36),igeo,intbuf_tab(nin)%MSEGTYP24 )
1811
1812C int24 : initial candidates for inacti=5 treatment -> sort at TT=0 during engine
1813 IF (inacti==5.OR.inacti==-1)THEN
1814 CALL i24cand(intbuf_tab(nin)%CAND_E,intbuf_tab(nin)%CAND_N,nsn ,
1815 + intbuf_tab(nin)%IRTLM ,intbuf_tab(nin)%I_STOK(1),
1816 * intbuf_tab(nin)%MSEGTYP24)
1817
1818 iedg4 = ipari(59,nin)
1819 IF(iedg4 > 0)THEN
1820C T24 E2E
1821C Initialize ISPT2 Arrays for cycle 0 in case of INACTI
1822 CALL ispt2_ini(intbuf_tab(nin)%CAND_N, intbuf_tab(nin)%I_STOK(1), nsn, intbuf_tab(nin)%IRTLM,
1823 * intbuf_tab(nin)%ISEGPT, intbuf_tab(nin)%ISPT2 )
1824
1825 ENDIF
1826 ELSE
1827 intbuf_tab(nin)%I_STOK(1)=0
1828 ENDIF
1829C-----------------------------------------------------------------------
1830 ELSEIF(nty==25) THEN
1831
1832 CALL my_alloc(intbuf_tab(nin)%EDGE_BISECTOR,intbuf_tab(nin)%S_EDGE_BISECTOR)
1833 intbuf_tab(nin)%EDGE_BISECTOR(1:intbuf_tab(nin)%S_EDGE_BISECTOR) = 0
1834
1835 CALL my_alloc(intbuf_tab(nin)%VTX_BISECTOR,intbuf_tab(nin)%S_VTX_BISECTOR)
1836 intbuf_tab(nin)%VTX_BISECTOR(1:intbuf_tab(nin)%S_VTX_BISECTOR) = 0
1837
1838 CALL my_alloc(intbuf_tab(nin)%PENM,intbuf_tab(nin)%S_PENM)
1839 intbuf_tab(nin)%PENM(1:intbuf_tab(nin)%S_PENM) = 0
1840
1841 CALL my_alloc(intbuf_tab(nin)%DISTM,intbuf_tab(nin)%S_DISTM)
1842 intbuf_tab(nin)%DISTM(1:intbuf_tab(nin)%S_DISTM) = 0
1843
1844 CALL my_alloc(intbuf_tab(nin)%LBM,intbuf_tab(nin)%S_LBM)
1845 intbuf_tab(nin)%LBM(1:intbuf_tab(nin)%S_LBM) = 0
1846
1847 CALL my_alloc(intbuf_tab(nin)%LCM,intbuf_tab(nin)%S_LCM)
1848 intbuf_tab(nin)%LCM(1:intbuf_tab(nin)%S_LCM) = 0
1849
1850 CALL my_alloc(intbuf_tab(nin)%E2S_NOD_NORMAL,intbuf_tab(nin)%S_E2S_NOD_NORMAL)
1851 intbuf_tab(nin)%E2S_NOD_NORMAL(1:intbuf_tab(nin)%S_E2S_NOD_NORMAL )= 0
1852
1853 CALL my_alloc(intbuf_tab(nin)%FTSAVX_E,intbuf_tab(nin)%S_FTSAVX_E )
1854 intbuf_tab(nin)%FTSAVX_E(1:intbuf_tab(nin)%S_FTSAVX_E) = 0
1855
1856 CALL my_alloc(intbuf_tab(nin)%FTSAVY_E,intbuf_tab(nin)%S_FTSAVY_E )
1857 intbuf_tab(nin)%FTSAVY_E(1:intbuf_tab(nin)%S_FTSAVY_E) = 0
1858
1859 CALL my_alloc(intbuf_tab(nin)%FTSAVZ_E,intbuf_tab(nin)%S_FTSAVZ _e)
1860 intbuf_tab(nin)%FTSAVZ_E(1:intbuf_tab(nin)%S_FTSAVZ_E) = 0
1861
1862 CALL my_alloc(intbuf_tab(nin)%FTSAVX_E2S,intbuf_tab(nin)%S_FTSAVX_E2S )
1863 intbuf_tab(nin)%FTSAVX_E2S(1:intbuf_tab(nin)%S_FTSAVX_E2S) = 0
1864
1865 CALL my_alloc(intbuf_tab(nin)%FTSAVY_E2S,intbuf_tab(nin)%S_FTSAVY_E2S )
1866 intbuf_tab(nin)%FTSAVY_E2S(1:intbuf_tab(nin)%S_FTSAVY_E2S) = 0
1867
1868 CALL my_alloc(intbuf_tab(nin)%FTSAVZ_E2S,intbuf_tab(nin)%S_FTSAVZ _e2s)
1869 intbuf_tab(nin)%FTSAVZ_E2S(1:intbuf_tab(nin)%S_FTSAVZ_E2S) = 0
1870
1871 CALL my_alloc(intbuf_tab(nin)%FARM,intbuf_tab(nin)%S_FARM) !KD(18)
1872 intbuf_tab(nin)%FARM(1:intbuf_tab(nin)%S_FARM) = 0
1873
1874C-----------------------------------------------------------------------
1875C
1876C Sorting NSV (Sorting again structural entities vs NSN, cf sub-interfaces, etc !)
1877 CALL i25sors(nsn, nrts, itab, ilev, ipari(1,nin),
1878 . intbuf_tab(nin))
1879C------
1880C IPEN0 = IPARI(54,NIN)
1881 ivis2 = ipari(14,nin)
1882 isharp= ipari(84,nin)
1883 nrtm0=nrtm-nrtm_sh
1884 IF(intth > 0) drad = intbuf_tab(nin)%VARIABLES(32)
1885
1886 CALL i7err3(
1887 1 x ,nrtm ,intbuf_tab(nin)%IRECTM ,noint ,itab,id,titr,
1888 2 ix1 ,ix2 ,ix3 ,ix4 ,x1 ,
1889 3 x2 ,x3 ,x4 ,y1 ,y2 ,
1890 4 y3 ,y4 ,z1 ,z2 ,z3 ,
1891 5 z4 ,n11 ,n21 ,n31 ,x0 ,
1892 6 y0 ,z0 ,xn1 ,yn1 ,zn1 ,
1893 7 xn2 ,yn2 ,zn2 ,xn3 ,yn3 ,
1894 8 zn3 ,xn4 ,yn4 ,zn4 )
1895C-----------------------------------------------------------
1896C NODAL AND ELEMENTARY STIFFNESS
1897C-----------------------------------------------------------
1898 gapscale=intbuf_tab(nin)%VARIABLES(13)
1899 ! Warning : VARIABLES(13) is modified after, to store GAPMIN
1900
1901 IF(ipari(72,nin) > 0) THEN ! friction model :
1902 ALLOCATE(ipartsm(nrtm)) ! saving parts id of main segments :friction mode + mvoisin research
1903 ipartsm(1:nrtm)=0
1904 ELSE
1905 ALLOCATE(ipartsm(0))
1906 ENDIF
1907 CALL i25sti3(
1908 1 x ,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%STFM ,ixs ,pm ,
1909 2 geo ,nrtm0 ,ixc ,-nin ,intbuf_tab(nin)%STFAC(1),
1910 3 nty ,intbuf_tab(nin)%VARIABLES(2),noint ,
1911 4 intbuf_tab(nin)%STFNS,nsn ,ms ,intbuf_tab(nin)%NSV,ixtg ,
1912 5 igap ,rwa ,intbuf_tab(nin)%GAP_S ,intbuf_tab(nin)%GAP_M,intbuf_tab(nin)%VARIABLES(13),
1913 6 gapscale ,ixt ,ixp,intbuf_tab(nin)%VARIABLES(6) ,intbuf_tab(nin)%VARIABLES(35),
1914 9 inacti ,knod2els ,knod2elc ,knod2eltg ,nod2els ,
1915 a nod2elc ,nod2eltg ,ipari(47,nin) ,
1916 b intbuf_tab(nin)%IELES,intbuf_tab(nin)%IELEM, intbuf_tab(nin)%AREAS,sh4tree ,sh3tree ,
1917 c ipart ,ipartc ,iparttg ,thk ,thk_part ,
1918 d ixr ,itab ,intbuf_tab(nin)%VARIABLES(7),ixs10 ,intbuf_tab(nin)%MSEGTYP24 ,
1919 e nrtm_sh ,ixs16 ,ixs20 ,intbuf_tab(nin)%GAP_NM,
1920 f ilev ,intbuf_tab(nin)%VARIABLES(36),id ,titr ,igap0 ,
1921 g intbuf_tab(nin)%PENE_OLD ,iparts ,igeo ,fillsol ,
1922 h stack%pm ,iworksh ,intbuf_tab(nin)%VARIABLES(28),intbuf_tab(nin)%GAP_SL,intbuf_tab(nin)%GAP_ML,
1923 i knod2el1d ,nod2el1d ,ipari(72,nin) ,tagprt_fric ,intbuf_tab(nin)%IPARTFRICS ,
1924 j intbuf_tab(nin)%IPARTFRICM,intbuf_fric_tab,ivis2 ,gapm_mx , gaps_mx ,
1925 k gapm_l_mx ,gaps_l_mx ,ipartsm ,drad ,ipartt ,
1926 j ipartp ,ipartr ,intbuf_tab(nin)%IELEM_M , ipari(100,nin),elem_linked_to_segment,
1927 k nin25 , flag_elem_inter25,intbuf_tab(nin)%VARIABLES(49),intbuf_tab(nin)%VARIABLES(50),
1928 m intbuf_tab(nin)%VARIABLES(51),intbuf_tab(nin)%VARIABLES(52))
1929 ipari(21,nin) = igap
1930C-----------------------------------------------------------
1931C ELEMENT NEIGHBROURS & FREE EDGES
1932C--------------------------------------------------------
1933C MVOISIN & NVOISIN are temporarily used to build ADMSR
1934C MVOISIN(1:4,1:NRTM) neighboring segments along each edge
1935C NVOISIN(1:8,1:NRTM) neighboring nodes on the 4 neighbors (on the cross)
1936C ADMSR(1:4,1:NRTM) adresses of node normals
1937C
1938 intbuf_tab(nin)%MVOISIN(1:4*nrtm)=0
1939 intbuf_tab(nin)%EVOISIN(1:4*nrtm)=0
1940 CALL i25neigh(
1941 1 nrtm ,nsn ,intbuf_tab(nin)%NSV,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%IRTLM,
1942 2 intbuf_tab(nin)%MVOISIN,intbuf_tab(nin)%EVOISIN,intbuf_tab(nin)%MSEGLO,intbuf_tab(nin)%MSEGTYP24,itab ,
1943 3 x ,id ,titr ,igeo ,ipari(67,nin) ,
1944 4 intbuf_tab(nin)%ADMSR,intbuf_tab(nin)%ADSKYN,intbuf_tab(nin)%IADNOR ,ipari(42,nin),iedge,
1945 5 ipari(68,nin),intbuf_tab(nin)%LEDGE,intbuf_tab(nin)%LBOUND,intbuf_tab(nin)%VARIABLES(26),ipari(36,nin),
1946 6 intbuf_tab(nin)%LISUB,intbuf_tab(nin)%ADDSUBM,intbuf_tab(nin)%LISUBM,intbuf_tab(nin)%INFLG_SUBM,
1947 . ipari(90,nin),
1948 7 intbuf_tab(nin)%ADDSUBE,intbuf_tab(nin)%LISUBE,intbuf_tab(nin)%INFLG_SUBE,noint,nmn,intbuf_tab(nin)%MSR,
1949 8 nom_opt,ilev,intbuf_tab(nin)%MBINFLG,intbuf_tab(nin)%EBINFLG,intbuf_tab(nin)%IELEM_M,
1950 9 ipari(100,nin))
1951
1952 IF(iedge/=0)THEN
1953 nconte =ipari(68,nin) ! See tale = Edge is to see ...
1954 ipari(88,nin)=nconte ! See tale = Edge is to see ...
1955 END IF
1956
1957 ithk25 = ipari(91,nin)
1958 CALL i25ini_gap_n(
1959 1 nrtm ,intbuf_tab(nin)%IRECTM,ixs ,geo ,ixc ,ixtg ,
1960 2 ixt ,ixp ,ipart ,ipartc ,iparttg ,
1961 3 thk ,thk_part,intbuf_tab(nin)%GAP_NM,intbuf_tab(nin)%GAP_M,nmn ,
1962 4 intbuf_tab(nin)%MSR,intbuf_tab(nin)%GAPN_M,
1963 . intbuf_tab(nin)%VARIABLES(36),gapscale,igeo ,
1964 5 intbuf_tab(nin)%MSEGTYP24 ,intbuf_tab(nin)%GAPMSAV, ithk25,igap,intbuf_tab(nin)%VARIABLES(50),intbuf_tab(nin)%VARIABLES(52))
1965
1966 nadmsr=ipari(67,nin)
1967 nedge =ipari(68,nin)
1968 CALL i25norm(nrtm,intbuf_tab(nin)%IRECTM,numnod,x,intbuf_tab(nin)%EDGE_BISECTOR,
1969 . nsn,intbuf_tab(nin)%MSR,itab,nrtm0,intbuf_tab(nin)%MSEGTYP24,
1970 . intbuf_tab(nin)%MVOISIN,intbuf_tab(nin)%EVOISIN,nedge,intbuf_tab(nin)%LEDGE,
1971 . intbuf_tab(nin)%LBOUND,intbuf_tab(nin)%ADMSR,intbuf_tab(nin)%VTX_BISECTOR,
1972 . intbuf_tab(nin)%E2S_NOD_NORMAL,nadmsr,iedge,intbuf_tab(nin)%IELEM_M)
1973C-----------------------------------------------------------
1974C IGAP = 2 (IREM GAP)
1975C-----------------------------------------------------------
1976 skip_type25_edge_2_edge = 2
1977 IF (iremnode == 1) THEN ! IDDLEVEL == 1 !
1978C
1979 intbuf_tab(nin)%VARIABLES(13)=zero ! fake value
1980 intbuf_tab(nin)%VARIABLES(16)=ep30 ! fake value
1981C
1982 CALL i7remnode(iremnode,noint,titr,intbuf_tab(nin),numnod+numfakenodigeo ,
1983 1 x,nrtm ,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,nsn,
1984 2 itab ,intbuf_tab(nin)%GAP_S,intbuf_tab(nin)%GAP_M,intbuf_tab(nin)%VARIABLES(13),intbuf_tab(nin)%VARIABLES(16),
1985 3 intbuf_tab(nin)%GAP_SL,intbuf_tab(nin)%GAP_ML,igap,intbuf_tab(nin)%VARIABLES(2),drad ,
1986 4 ipari(62,nin) ,nty ,ipari(1,nin) ,i_mem_rem ,gapm_mx ,
1987 5 gaps_mx ,gapm_l_mx ,gaps_l_mx ,ilev ,intbuf_tab(nin)%NBINFLG ,
1988 6 intbuf_tab(nin)%MBINFLG,intbuf_tab(nin)%VARIABLES(46),npari)
1989C
1990 END IF
1991 IF (nspmd>1.AND.iddlevel==0.AND.flag_removed_node) THEN
1992 flag_output = 0
1993 nremn(1:ninter) = 0
1994 IF (inter_type2_number >0) CALL remn_i2op(nin,nin,ipari,intbuf_tab,itab,nom_opt,nremn,flag_output,skip_type25_edge_2_edge)
1995 ENDIF
1996C-----------------------------------------------------------
1997C
1998C STILL ONE BUCKET SORT
1999C
2000 maxbox = intbuf_tab(nin)%VARIABLES(9)
2001 minbox = intbuf_tab(nin)%VARIABLES(12)
2002 penmn = intbuf_tab(nin)%VARIABLES(38)
2003 penmax = intbuf_tab(nin)%VARIABLES(37)
2004 local_flag_removed_node = flag_removed_node
2005 IF(iddlevel==0.AND.flag_removed_node) local_flag_removed_node = .false.
2006 i_mem = 0
2007 CALL i25buc_vox1(
2008 1 x ,intbuf_tab(nin)%IRECTM ,intbuf_tab(nin)%NSV,intbuf_tab(nin)%VARIABLES(4),
2009 2 nmn ,nrtm ,nsn ,intbuf_tab(nin) ,
2010 3 intbuf_tab(nin)%VARIABLES(2),i_stok ,
2011 4 intbuf_tab(nin)%VARIABLES(5),intbuf_tab(nin)%VARIABLES(8),maxbox ,minbox,intbuf_tab(nin)%MSR,
2012 5 intbuf_tab(nin)%STFM ,intbuf_tab(nin)%STFNS ,iddlevel ,
2013 6 intbuf_tab(nin)%GAP_S,intbuf_tab(nin)%GAP_M,igap,intbuf_tab(nin)%VARIABLES(13),
2014 7 intbuf_tab(nin)%VARIABLES(16),inacti ,intbuf_tab(nin)%GAP_SL,intbuf_tab(nin)%GAP_ML,
2015 8 intbuf_tab(nin)%VARIABLES(25),id ,titr ,intbuf_tab(nin)%NBINFLG ,intbuf_tab(nin)%MBINFLG,
2016 9 ilev ,intbuf_tab(nin)%MSEGTYP24,intbuf_tab(nin)%GAP_NM,intbuf_tab(nin)%VARIABLES(7),
2017 a iparts ,knod2els ,nod2els ,
2018 b intbuf_tab(nin)%KREMNODE,intbuf_tab(nin)%REMNODE,
2019 c ixs, ixs10, ixs16, ixs20,icode,iskew,
2020 d drad,intbuf_tab(nin)%VARIABLES(46),nrtm,local_flag_removed_node,
2021 e intbuf_tab(nin)%IELEM_M,nin,npari,ipari(1,nin))
2022
2023C
2024 IF(iedge/=0)THEN
2025
2026 CALL i25sti_edg(
2027 1 nedge ,intbuf_tab(nin)%LEDGE ,intbuf_tab(nin)%STFE ,intbuf_tab(nin)%STFM ,igap ,
2028 2 intbuf_tab(nin)%GAPE,intbuf_tab(nin)%GAP_E_L,intbuf_tab(nin)%GAP_M ,intbuf_tab(nin)%GAP_ML,intbuf_tab(nin)%GAP_SL,
2029 3 intbuf_tab(nin)%VARIABLES(40),ipari(72,nin),intbuf_tab(nin)%IPARTFRIC_E,intbuf_tab(nin)%IPARTFRICM,ipartsm ,
2030 4 bgapemx_l ,nsn ,intbuf_tab(nin)%NSV )
2031
2032 intbuf_tab(nin)%I_STOK_E(1:2)=0
2033 cand_e_old(1:2) = intbuf_tab(nin)%I_STOK_E(1:2)
2034
2035 2510 continue
2036
2037
2038C
2039 IF (iremnode_edg == 1) THEN
2040C
2041 ALLOCATE(inod2lin(numnod+1),tagsecnd(numnod),nod2lin(2*nedge),perm(nedge),perminv(nedge),gap_maxneigh(nedge))
2042 i_start = 1
2043 i_mem_rem = 0
2044 DO WHILE (i_start < nedge)
2045C
2046 CALL i25remline(
2047 1 x ,nedge ,intbuf_tab(nin)%LEDGE,numnod ,intbuf_tab(nin)%GAPE ,intbuf_tab(nin)%GAP_E_L ,
2048 2 igap0 ,igap ,drad ,intbuf_tab(nin)%VARIABLES(40),bgapemx_l ,intbuf_tab(nin)%KREMNODE_EDG,
2049 3 intbuf_tab(nin)%REMNODE_EDG,ipari(94,nin),i_start ,i_mem_rem ,inod2lin ,
2050 4 tagsecnd ,nod2lin ,intbuf_tab(nin)%VARIABLES(46) ,perm ,perminv ,
2051 5 gap_maxneigh)
2052C
2053C Reallocation of REMNODE arrays if necessary
2054C
2055 IF (i_mem_rem == 1) THEN
2056 new_size = ipari(94,nin) + 5*nedge
2057 CALL upgrade_remnode_edg(ipari(1,nin),new_size,intbuf_tab(nin))
2058 i_mem_rem = 0
2059 ENDIF
2060C
2061 ENDDO
2062C
2063 DEALLOCATE(inod2lin,tagsecnd,nod2lin,perm,perminv,gap_maxneigh)
2064 iremnode_edg = 0
2065C
2066 ENDIF
2067
2068
2069 itask = 0
2070 eshift = 0
2071 nedge_t = nedge
2072 sshift = 0
2073 nrtm_t = nrtm
2074
2075 nconte = ipari(88,nin)
2076 multimpe = ipari(87,nin)
2077 multimps = ipari(89,nin)
2078 mulnsne = multimpe*nconte
2079 mulnsns = multimps*nconte
2080
2081 marge = intbuf_tab(nin)%VARIABLES(25) ! same margin : elem to elem AND node to surf
2082 gap = intbuf_tab(nin)%VARIABLES(2)
2083 vmaxdt = zero
2084 i_meme(1:2)= 0
2085 inactbid =0 ! nothing to do wrt old impacts in RD Starter
2086 CALL i25buce_edg(
2087 1 x ,intbuf_tab(nin)%IRECTM,inactbid,nsn ,
2088 2 nmn ,intbuf_tab(nin)%CANDM_E2E ,intbuf_tab(nin)%CANDS_E2E ,
2089 3 gap ,noint ,intbuf_tab(nin)%I_STOK_E(1) ,mulnsne ,bminma ,
2090 4 marge ,vmaxdt ,drad ,eshift ,nedge_t ,
2091 5 sshift ,nrtm_t ,intbuf_tab(nin)%STFM ,intbuf_tab(nin)%STFNS,
2092 6 nconte ,intbuf_tab(nin)%GAP_M ,itask ,intbuf_tab(nin)%VARIABLES(40),
2093 7 i_meme ,itab ,intbuf_tab(nin)%MBINFLG,intbuf_tab(nin)%EBINFLG,intbuf_tab(nin)%I_STOK_E(2) ,
2094 8 mulnsns,ilev ,ibidon ,intbuf_tab(nin)%CAND_P ,igap0 ,
2095 9 ipari(63,nin),intbuf_tab(nin)%KREMNODE_EDG(1+2*eshift),intbuf_tab(nin)%REMNODE_EDG, intbuf_tab(nin)%S_REMNODE_EDG,
2096 a igap ,intbuf_tab(nin)%GAP_ML,iedge ,nedge ,intbuf_tab(nin)%MSEGTYP24,
2097 b intbuf_tab(nin)%LEDGE,intbuf_tab(nin)%ADMSR,intbuf_tab(nin)%EDGE_BISECTOR,intbuf_tab(nin)%VTX_BISECTOR,
2098 c intbuf_tab(nin)%CANDM_E2S ,intbuf_tab(nin)%CANDS_E2S,ibidon,intbuf_tab(nin)%CAND_PS,intbuf_tab(nin)%GAPE,
2099 d intbuf_tab(nin)%GAP_E_L,intbuf_tab(nin)%VARIABLES(46),flag_removed_node,
2100 e intbuf_tab(nin)%S_KREMNODE_E2S,intbuf_tab(nin)%S_REMNODE_E2S,intbuf_tab(nin)%KREMNODE_E2S,intbuf_tab(nin)%REMNODE_E2S,
2101 f intbuf_tab(nin)%S_KREMNODE_EDG)
2102
2103 IF(i_meme(1) /=0 .OR. i_meme(2)/=0)THEN
2104 nconte = ipari(88,nin)
2105 IF(i_meme(1)/=0)THEN ! Main shell edges
2106 multimpe = max(ipari(87,nin)+8,nint(ipari(87,nin)*1.75))
2107 multimpe = max(multimpe,intbuf_tab(nin)%S_CANDL_MAX / max(1,nconte))
2108 intbuf_tab(nin)%S_CANDL_MAX =
2109 . max(multimpe*nconte,intbuf_tab(nin)%S_CANDL_MAX)
2110 CALL upgrade_lcand_edg(nin,multimpe,intbuf_tab(nin))
2111 END IF
2112 IF(i_meme(2)/=0)THEN ! Main Solid edges
2113 multimps = max(ipari(89,nin)+8,nint(ipari(89,nin)*1.75))
2114 multimps = max(multimps,intbuf_tab(nin)%S_CANDS_MAX / max(1,nconte))
2115 intbuf_tab(nin)%S_CANDS_MAX =
2116 . max(multimps*nconte,intbuf_tab(nin)%S_CANDS_MAX)
2117 CALL upgrade_lcand_e2s(nin,multimps,intbuf_tab(nin))
2118 END IF
2119 i_meme(1:2) = 0
2120 intbuf_tab(nin)%I_STOK_E(1:2)=cand_e_old(1:2)
2121 GOTO 2510 ! sorting/searching all again
2122 END IF
2123 ENDIF
2124C
2125 ! -----------------
2126 ! update the weight of candidate's pair for the domain decomposition
2127 IF (iddlevel==0.AND.nspmd>1)THEN
2128 total_number_candidate = i_stok
2129 IF(iedge/=0) total_number_candidate = total_number_candidate + intbuf_tab(nin)%I_STOK_E(1) + intbuf_tab(nin)%I_STOK_E(2)
2130 IF ( ((nelemint+total_number_candidate)) > inter_cand%S_IXINT_2) THEN
2131 CALL upgrade_ixint(inter_cand,nelemint,total_number_candidate)
2132 ENDIF
2133
2134 dgapload = intbuf_tab(nin)%VARIABLES(46)
2135 kind_inter = 25
2136 CALL update_weight_inter_type_24_25(numnod,nelemint,nin,nsn,nrtm,
2137 . ifiend,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,i_stok,intbuf_tab(nin)%CAND_E,
2138 . intbuf_tab(nin)%CAND_N,dgapload,intbuf_tab(nin)%GAP_S,intbuf_tab(nin)%GAP_M,x,inter_cand,
2139 . kind_inter,intbuf_tab(nin),iedge,nledge)
2140 ENDIF
2141 ! -----------------
2142
2143 IF((iddlevel == 0) .AND. (dectyp>=3.AND.dectyp<=6))THEN
2144C nodal weights and interfaces
2145 CALL iwcontdd_type25(nledge,numnod,nsn,nmn,iedge,
2146 . nrtm,nedge,intbuf_tab(nin)%NSV,intbuf_tab(nin)%MSR,intbuf_tab(nin)%IRECTM,
2147 . iwcont,nsnt,nmnt,intbuf_tab(nin))
2148 END IF
2149
2150 IF(iddlevel==1)THEN
2151C-------------------------------------------------------------
2152C INITIAL PENETRATIONS
2153C-------------------------------------------------------------
2154 ngrous=1+(i_stok-1)/nvsiz
2155 IF (ngrous>0) THEN
2156C
2157 DO i=1,4*nsn
2158 intbuf_tab(nin)%IRTLM(i)=0
2159 END DO
2160C
2161 intbuf_tab(nin)%PENE_OLD(1:5*nsn)=zero
2162 intbuf_tab(nin)%TIME_S(1:nsn)=ep20
2163C
2164 DO ng=1,ngrous
2165 nft = (ng-1) * nvsiz
2166 lft = 1
2167 llt = min0( nvsiz, i_stok - nft )
2168
2169 CALL i25cor3(
2170 1 llt ,igap ,x ,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,
2171 2 intbuf_tab(nin)%CAND_E(1+nft),intbuf_tab(nin)%CAND_N(1+nft) ,xi, yi, zi,
2172 4 ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
2173 5 nsn ,intbuf_tab(nin)%GAP_S ,gaps ,intbuf_tab(nin)%ADMSR ,intbuf_tab(nin)%EDGE_BISECTOR ,
2174 7 x1 ,x2 ,x3 ,x4 ,x0 ,
2175 8 y1 ,y2 ,y3 ,y4 ,y0 ,
2176 9 z1 ,z2 ,z3 ,z4 ,z0 ,
2177 a nnx ,nny ,nnz ,intbuf_tab(nin)%MVOISIN ,mvoisn ,
2178 b intbuf_tab(nin)%GAP_M ,gapm ,intbuf_tab(nin)%GAP_NM, gap_nm,
2179 c intbuf_tab(nin)%GAP_SL ,intbuf_tab(nin)%GAP_ML ,gapmxl,intbuf_tab(nin)%LBOUND ,ibound )
2180
2181 CALL i25pen3(llt ,intbuf_tab(nin)%CAND_N(1+nft),intbuf_tab(nin)%CAND_E(1+nft),penmn ,penmax,
2182 2 x1 ,x2 ,x3 ,x4 ,x0 ,
2183 3 y1 ,y2 ,y3 ,y4 ,y0 ,
2184 4 z1 ,z2 ,z3 ,z4 ,z0 ,
2185 5 xi ,yi ,zi ,nsn ,ix1 ,
2186 6 ix2 ,ix3 ,ix4 ,nsvg ,nrtm ,
2187 7 intbuf_tab(nin)%MSEGLO ,gaps ,intbuf_tab(nin)%IRECTM ,intbuf_tab(nin)%IRTLM ,
2188 8 intbuf_tab(nin)%TIME_S ,intbuf_tab(nin)%PENE_OLD,itab ,intbuf_tab(nin)%MSEGTYP24,isharp,
2189 9 nnx ,nny ,nnz ,gap_nm ,mvoisn,
2190 a gapmxl ,ivis2 ,ibound,intbuf_tab(nin)%VTX_BISECTOR,ilev,
2191 b inacti )
2192
2193 ENDDO
2194C
2195 iwpene0 = 0
2196 CALL i25pwr3(
2197 . itab ,inacti,intbuf_tab(nin)%CAND_E,intbuf_tab(nin)%CAND_N,intbuf_tab(nin)%STFNS,
2198 1 x ,i_stok,intbuf_tab(nin)%NSV,iwpene ,intbuf_tab(nin)%PENE_OLD,
2199 2 noint ,nty ,intbuf_tab(nin)%MSR,intbuf_tab(nin)%IRTLM,intbuf_tab(nin)%IRECTM ,
2200 3 nsn ,id ,titr ,intbuf_tab(nin)%MSEGLO,intbuf_tab(nin)%ICONT_I,
2201 4 iwpene0,intbuf_tab(nin)%VARIABLES(38),iresp)
2202C
2203 END IF !(NGROUS>0) THEN
2204C-------------------------------------------------------------
2205 CALL ancmsg(msgid=1164, msgtype=msgwarning,anmode=aninfo_blind_1,i1=id,c1=titr,prmod=msg_print)
2206C
2207 IF(iwpene /= 0.AND. iddlevel == 1)THEN
2208 IF(inacti==0)THEN
2209 CALL ancmsg(msgid=1166,msgtype=msgwarning,anmode=aninfo_blind_1,i1=id,c1=titr,i2=iwpene,i3=iwpene0)
2210 ELSEIF(inacti==5.AND. iddlevel == 1)THEN
2211 CALL ancmsg(msgid=1167,msgtype=msgwarning,anmode=aninfo_blind_1,i1=id,c1=titr,i2=iwpene)
2212 ELSEIF(inacti==-1.AND. iddlevel == 1)THEN
2213 CALL ancmsg(msgid=1168,msgtype=msgwarning,anmode=aninfo_blind_1,i1=id,c1=titr,i2=iwpene)
2214 ELSE
2215 CALL ancmsg(msgid=1165,msgtype=msgerror,anmode=aninfo_blind_1,i1=id,c1=titr,i2=inacti)
2216 END IF
2217 END IF
2218C
2219 inpene = iwpene
2220 IF (inacti==5.OR.inacti==-1) THEN
2221 DO i=1,nsn
2222 intbuf_tab(nin)%PENE_OLD(5*(i-1)+1)=zero
2223 intbuf_tab(nin)%PENE_OLD(5*(i-1)+2)=zero
2224 END DO
2225C
2226 intbuf_tab(nin)%VARIABLES(23) = zero
2227C
2228C INT25 : initial candidates for inacti=5 treatment (keep symmetrical) <=> sorting at TT=0 during engine
2229 CALL i25cand(intbuf_tab(nin)%CAND_E,intbuf_tab(nin)%CAND_N,nsn ,
2230 + intbuf_tab(nin)%IRTLM ,intbuf_tab(nin)%I_STOK(1),
2231 * nrtm ,intbuf_tab(nin)%MSEGTYP24)
2232 ELSE
2233 intbuf_tab(nin)%I_STOK(1)=0
2234 END IF
2235C------------------------------------------------------------
2236 IF (iedge /=0)THEN
2237 iwpene=0
2238 IF(intbuf_tab(nin)%I_STOK_E(1) > 0) THEN
2239C
2240 istok=0
2241C
2242 ngrous=1+(intbuf_tab(nin)%I_STOK_E(1)-1)/nvsiz
2243 DO ng=1,ngrous
2244 nft = (ng-1) * nvsiz
2245 lft = 1
2246 llt = min0( nvsiz, intbuf_tab(nin)%I_STOK_E(1) - nft )
2247
2248 CALL i25cor3e(
2249 1 llt ,intbuf_tab(nin)%LEDGE,intbuf_tab(nin)%IRECTM,x ,
2250 2 intbuf_tab(nin)%CANDS_E2E(1+nft) ,intbuf_tab(nin)%CANDM_E2E(1+nft) ,
2251 3 xxs1 ,xxs2 ,xys1 ,xys2 ,xzs1 ,
2252 4 xzs2 ,xxm1 ,xxm2 ,xym1 ,xym2 ,
2253 5 xzm1 ,xzm2 ,ex ,ey ,ez ,
2254 7 fx ,fy ,fz ,
2255 8 n1 ,n2 ,m1 ,m2 ,nedge ,
2256 9 intbuf_tab(nin)%GAPE,gapve,
2257 a iedge ,intbuf_tab(nin)%ADMSR,intbuf_tab(nin)%LBOUND,intbuf_tab(nin)%EDGE_BISECTOR,
2258 b intbuf_tab(nin)%VTX_BISECTOR ,itab ,igap0 ,igap ,
2259 c intbuf_tab(nin)%GAP_E_L)
2260
2261 CALL i25pen3e(
2262 1 llt ,iedge ,intbuf_tab(nin)%CANDS_E2E(1+nft) ,intbuf_tab(nin)%CANDM_E2E(1+nft) ,
2263 2 n1 ,n2 ,m1 ,m2 ,
2264 3 xxs1 ,xxs2 ,xys1 ,xys2 ,
2265 4 xzs1 ,xzs2 ,xxm1 ,xxm2 ,xym1 ,
2266 5 xym2 ,xzm1 ,xzm2 ,gapve ,pene ,
2267 6 ex ,ey ,ez ,fx ,fy ,
2268 7 fz ,intbuf_tab(nin)%LEDGE,intbuf_tab(nin)%IRECTM,x ,itab )
2269
2270 CALL i25pwr3e(
2271 1 itab ,inacti,intbuf_tab(nin)%CANDM_E2E(1+nft),intbuf_tab(nin)%CANDS_E2E(1+nft),istok,
2272 2 llt ,pene ,iwpene ,intbuf_tab(nin)%CAND_P(1+nft) ,
2273 3 n1 ,n2 ,m1 ,m2 ,
2274 4 noint ,nty ,intbuf_tab(nin)%IRECTM ,id ,titr ,
2275 5 intbuf_tab(nin)%CANDM_E2E,intbuf_tab(nin)%CANDS_E2E,intbuf_tab(nin)%CAND_P,iedge,nledge,
2276 6 nedge ,intbuf_tab(nin)%LEDGE)
2277
2278 ENDDO
2279 intbuf_tab(nin)%I_STOK_E(1)=istok
2280 CALL shrink_array(intbuf_tab(nin)%CANDM_E2E,istok)
2281 CALL shrink_array(intbuf_tab(nin)%CANDS_E2E,istok)
2282 END IF
2283C------------------------------------------------------------
2284 IF(intbuf_tab(nin)%I_STOK_E(2) > 0) THEN
2285C
2286 istok=0
2287C
2288 ngrous=1+(intbuf_tab(nin)%I_STOK_E(2)-1)/nvsiz
2289 DO ng=1,ngrous
2290 nft = (ng-1) * nvsiz
2291 lft = 1
2292 llt = min0( nvsiz, intbuf_tab(nin)%I_STOK_E(2) - nft )
2293
2294 CALL i25cor3_e2s(
2295 1 llt ,intbuf_tab(nin)%LEDGE,intbuf_tab(nin)%IRECTM,x ,
2296 2 intbuf_tab(nin)%CANDS_E2S(1+nft) ,intbuf_tab(nin)%CANDM_E2S(1+nft) ,ex ,ey ,ez ,
2297 3 xxs1 ,xxs2 ,xys1 ,xys2 ,
2298 4 xzs1 ,xzs2 ,xxm1 ,xxm2 ,xym1 ,
2299 5 xym2 ,xzm1 ,xzm2 ,
2300 6 n1 ,n2 ,m1 ,m2 ,nedge ,
2301 7 intbuf_tab(nin)%GAPE,gapve ,fx ,fy ,fz ,
2302 8 iedge ,intbuf_tab(nin)%ADMSR,intbuf_tab(nin)%LBOUND,intbuf_tab(nin)%EDGE_BISECTOR,
2303 9 intbuf_tab(nin)%VTX_BISECTOR,itab )
2304
2305 CALL i25dst3_e2s(
2306 1 llt ,iedge ,intbuf_tab(nin)%CANDS_E2S(1+nft) ,intbuf_tab(nin)%CANDM_E2S(1+nft) ,
2307 2 n1 ,n2 ,m1 ,m2 ,
2308 3 xxs1 ,xxs2 ,xys1 ,xys2 ,
2309 4 xzs1 ,xzs2 ,xxm1 ,xxm2 ,xym1 ,
2310 5 xym2 ,xzm1 ,xzm2 ,gapve ,pene ,
2311 6 ex ,ey ,ez ,fx ,fy ,
2312 7 fz ,intbuf_tab(nin)%LEDGE,intbuf_tab(nin)%IRECTM,x ,itab ,intbuf_tab(nin)%E2S_NOD_NORMAL,
2313 8 intbuf_tab(nin)%ADMSR)
2314
2315 CALL i25pwr3_e2s(
2316 1 itab ,inacti,intbuf_tab(nin)%CANDM_E2S(1+nft),intbuf_tab(nin)%CANDS_E2S(1+nft),istok,
2317 2 llt ,pene ,iwpene ,intbuf_tab(nin)%CAND_PS(1+4*nft) ,
2318 3 n1 ,n2 ,m1 ,m2 ,
2319 4 noint ,nty ,intbuf_tab(nin)%IRECTM ,id ,titr ,
2320 5 intbuf_tab(nin)%CANDM_E2S,intbuf_tab(nin)%CANDS_E2S,intbuf_tab(nin)%CAND_PS)
2321
2322 ENDDO
2323 intbuf_tab(nin)%I_STOK_E(2)=istok
2324 CALL shrink_array(intbuf_tab(nin)%CAND_PS,4*istok)
2325 CALL shrink_array(intbuf_tab(nin)%CANDM_E2S,istok)
2326 CALL shrink_array(intbuf_tab(nin)%CANDS_E2S,istok)
2327 CALL shrink_array(intbuf_tab(nin)%IFPEN_E2S,istok)
2328 END IF
2329C------------------------------------------------------------
2330 CALL ancmsg(msgid=1631,msgtype=msgwarning,anmode=aninfo_blind_1,i1=id,c1=titr,prmod=msg_print)
2331C
2332 IF(iwpene /= 0 .AND. iddlevel == 1)THEN
2333 IF(inacti==0)THEN
2334 CALL ancmsg(msgid=1632, msgtype=msgwarning,anmode=aninfo_blind_1,i1=id, c1=titr, i2=iwpene)
2335 ELSEIF(inacti==5)THEN
2336 CALL ancmsg(msgid=1633,msgtype=msgwarning,anmode=aninfo_blind_1,i1=id,c1=titr,i2=iwpene)
2337 ELSEIF(inacti==-1)THEN
2338 CALL ancmsg(msgid=1634,msgtype=msgwarning,anmode=aninfo_blind_1,i1=id,c1=titr, i2=iwpene)
2339 END IF
2340 END IF
2341 END IF !(NGROUS>0) THEN
2342C
2343 END IF ! IF(IDDLEVEL==1)THEN
2344 DEALLOCATE (ipartsm)
2345C-----------------------------------------------------------------------
2346 ENDIF
2347C-----------------------------------------------------------------------
2348 IF(iwpene/=0) THEN
2349 IF(inpene/=0 .AND. iddlevel == 1)THEN
2350 IF(.NOT.type18)CALL ancmsg(msgid=343,msgtype=msgwarning,anmode=aninfo_blind_1,i1=id,c1=titr,i2=iwpene,i3=inpene)
2351 ELSEIF (iddlevel == 1.AND.nty/=24) THEN
2352 IF(.NOT.type18)CALL ancmsg(msgid=499, msgtype=msgwarning,anmode=aninfo_blind_1,i1=id,c1=titr,i2=iwpene)
2353 ENDIF
2354 IF(nty==24.AND. iddlevel == 1) THEN
2355 SELECT CASE (inacti)
2356 CASE(0,1)
2357 CALL ancmsg(msgid=1184, msgtype=msgwarning,anmode=aninfo_blind_1,i1=id,c1=titr, i2=iwpene,i3=iwpene0)
2358 CASE(-1)
2359 CALL ancmsg(msgid=1185,msgtype=msgwarning,anmode=aninfo_blind_1,i1=id,c1=titr,i2=iwpene,i3=iwpene0)
2360 CASE(5)
2361 CALL ancmsg(msgid=1186,msgtype=msgwarning,anmode=aninfo_blind_1,i1=id,c1=titr,i2=iwpene,i3=iwpene0)
2362 END SELECT
2363 IF(ipri>=5.AND. iddlevel == 1) THEN
2364 CALL ancmsg(msgid=1164,msgtype=msgwarning,anmode=aninfo_blind_1,i1=id,c1=titr,prmod=msg_print)
2365 ENDIF
2366 END IF
2367 ENDIF
2368
2369
2370 IF(ALLOCATED(intbuf_tab(nin)%VTX_BISECTOR)) THEN
2371 DEALLOCATE(intbuf_tab(nin)%VTX_BISECTOR)
2372 ENDIF
2373 IF(ALLOCATED(intbuf_tab(nin)%EDGE_BISECTOR)) THEN
2374 DEALLOCATE(intbuf_tab(nin)%EDGE_BISECTOR)
2375 ENDIF
2376 IF(ALLOCATED(intbuf_tab(nin)%PENM)) THEN
2377 DEALLOCATE(intbuf_tab(nin)%PENM)
2378 ENDIF
2379 IF(ALLOCATED(intbuf_tab(nin)%DISTM)) DEALLOCATE(intbuf_tab(nin)%DISTM)
2380 IF(ALLOCATED(intbuf_tab(nin)%LBM)) DEALLOCATE(intbuf_tab(nin)%LBM)
2381 IF(ALLOCATED(intbuf_tab(nin)%LCM )) DEALLOCATE(intbuf_tab(nin)%LCM)
2382 IF(ALLOCATED(intbuf_tab(nin)%E2S_NOD_NORMAL)) DEALLOCATE(intbuf_tab(nin)%E2S_NOD_NORMAL)
2383 IF(ALLOCATED(intbuf_tab(nin)%E2S_ACTNOR)) DEALLOCATE(intbuf_tab(nin)%E2S_ACTNOR)
2384 IF(ALLOCATED(intbuf_tab(nin)%FTSAVX_E) ) DEALLOCATE(intbuf_tab(nin)%FTSAVX_E)
2385 IF(ALLOCATED(intbuf_tab(nin)%FTSAVY_E) ) DEALLOCATE(intbuf_tab(nin)%FTSAVY_E)
2386 IF(ALLOCATED(intbuf_tab(nin)%FTSAVZ_E) ) DEALLOCATE(intbuf_tab(nin)%FTSAVZ_E)
2387 IF(ALLOCATED(intbuf_tab(nin)%FTSAVX_E2S) ) DEALLOCATE(intbuf_tab(nin)%FTSAVX_E2S)
2388 IF(ALLOCATED(intbuf_tab(nin)%FTSAVY_E2S) ) DEALLOCATE(intbuf_tab(nin)%FTSAVY_E2S)
2389 IF(ALLOCATED(intbuf_tab(nin)%FTSAVZ_E2S) ) DEALLOCATE(intbuf_tab(nin)%FTSAVZ_E2S)
2390 IF(ALLOCATED(intbuf_tab(nin)%FARM) ) DEALLOCATE(intbuf_tab(nin)%FARM)
2391
2392
2393C
2394 RETURN
2395C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
2396 2001 FORMAT(//,1x,'INTERFACE NUMBER. . . . . . . . . . . . . .',i10/
2397 + ,1x,'INTERFACE TYPE. . . . . . . . . . . . . . .',i6/)
2398 2002 FORMAT(//
2399 +' SECONDARY NEAREST NEAREST MAIN NODES SECONDARY '/
2400 +' NODE MAIN SEGMENT S T')
2401 2003 FORMAT(//
2402 +' MAIN NEAREST NEAREST SECONDARY NODES MAIN'/
2403 +' NODE SECONDARY SEGMENT S T')
2404 2007 FORMAT(//' IMPACT CANDIDATES',/,' SECONDARY MAIN SEGMENT NODES '/' NODE ')
2405 2011 FORMAT(//' IMPACT CANDIDATES',/,' MAIN NODES SECONDARY NODES ')
2406 2012 FORMAT(2x,'** WARNING ** THIS INTERFACE CONNECTS',' LAGRANGIAN MATERIALS')
2407 2181 FORMAT(//,1x,'INTERFACE NUMBER. . . . . . . . . . . . . .',i10/
2408 + ,1x,'INTERFACE TYPE. . . . . . . . . . . . . . . 18')
2409 2200 FORMAT(2x,/,i8,' TINY INITIAL PENETRATIONS WILL BE TAKEN INTO
2410 + ACCOUNT')
2411 2300 FORMAT(2x,/,i8,' INITIAL PENETRATIONS WILL BE IGNORED ')
2412 2400 FORMAT(2x,/,'IPEN_MAX = ',1pg20.13,'HAS BEEN USED')
2413 2500 FORMAT(/,
2414 . 'FICTIVE NODES ADDED FOR EDGE . . . . . . . . =',i10/,
2415 . 'RATIO of Fictive SECONDARY nodes/SECONDARY nodes. . =',1pg20.13/)
2416 END
2417
my_real
#define my_real
Definition cppsort.cpp:32
iwcontdd
subroutine iwcontdd(nsv, msr, nsn, nmn, iwcont, nsnt, nmnt)
Definition grid2mat.F:3007
iwcontdd_151
subroutine iwcontdd_151(bufbric, nbric, msr, nmn, iwcont, nsnt, nmnt, numnod, ixs, numels, nale)
Definition grid2mat.F:3045
i2wcontdd
subroutine i2wcontdd(nsv, msr, nsn, nmn, iwcont, nsnt, nmnt)
Definition grid2mat.F:2939
i11buc_vox1
subroutine i11buc_vox1(x, irects, irectm, nrts, nmn, nrtm, nsn, cand_m, cand_s, maxgap, noint, ii_stok, tzinf, maxbox, minbox, ncontact, multimp, msr, addcm, chaine, itab, nsv, iauto, i_mem, id, titr, iddlevel, bumult, drad, intercep, igap, gap_s, gap_m, gap_s_l, gap_m_l, gapmin, flagremnode, kremnode, remnode, dgapload)
Definition i11buc1.F:46
i11pwr3
subroutine i11pwr3(itab, inacti, cand_m, cand_s, stfs, stfm, x, nsv, iwpene, n1, n2, m1, m2, nx, ny, nz, gapv, gap_s, gap_m, penis, penim, igap, print_warning)
Definition i11pwr3.F:35
i11remline
subroutine i11remline(x, nrtm, irectm, nrts, irects, numnod, gap_s, gap_m, gapmin, igap, kremnode, remnode, gap, drad, nremnode, i_start, i_mem_rem, inod2lin, tagsecnd, nod2lin, dgapload, gap_s_l, gap_m_l)
Definition i11remlin.F:37
i11sti3
subroutine i11sti3(x, irect, stf, ixs, pm, geo, nrt, ixc, nintr, slsfac, nty, gapmax, noint, gap_sm, ms, ixtg, ixt, ixp, ixr, igap, gapmin, gap0, gapinf, ipartc, iparttg, thk, thk_part, percent_size, gap_l, nod2el1d, knod2el1d, itab, ixs10, id, titr, kxx, ixx, igeo, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, lelx, fillsol, intth, drad, area, ielec, pm_stack, iworksh, it19, bgapsmx, intfric, iparts, tagprt_fric, ipartfric, intbuf_fric_tab, ipartt, ipartp, ipartx, ipartr, irem_gap)
Definition i11sti3.F:56
i12chk3
subroutine i12chk3(x, irect, ixs, nrt, ixc, nint, nsn, nsv, noint, mwa, ixtg, pm, iseg, ale_connectivity, varconvint, fcount, itied, itab, knod2els, nod2els, nty, id, titr)
Definition i12chk3.F:41
i12tid3
subroutine i12tid3(x, irect, crst, msr, nsv, iloc, irtl, nsn, itab, alp, id, titr)
Definition i12tid3.F:39
i17sti3
subroutine i17sti3(ixs, pm, nme, nmes, nelm, nels, km, ks)
Definition i17sti3.F:32
i18pwr3
subroutine i18pwr3(itab, inacti, cand_e, cand_n, stfn, stf, x, nsv, iwpene, cand_p, cand_en, cand_nn, tag, noint, gapv, ix1, ix2, ix3, ix4, nsvg, pene)
Definition i18pwr3.F:35
i1chk3
subroutine i1chk3(x, irect, ixs, nrt, ixc, nint, nsn, nsv, noint, ixtg, geo, pm, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, igrsurf, thk, nty, ixs10, ixs16, ixs20, id, titr, igeo, pm_stack, iworksh)
Definition i1chk3.F:44
i1tid3
subroutine i1tid3(x, irect, crst, msr, nsv, iloc, irtl, nsn, itab, ikine, ikine1, id, titr, ilev, nty, csts_bis)
Definition i1tid3.F:38
i20ini3
subroutine i20ini3(x, ixs, ixc, pm, geo, ipari, interface_id, itab, ms, mwa, rwa, ixtg, iwrn, ikine, ixt, ixp, ixr, nelemint, iddlevel, ifiend, nsnet, nmnet, iwcont, nsnt, nmnt, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, igrsurf, ikine1, ipart, ipartc, iparttg, thk, thk_part, inpene, iwpentot, ixs10, i_mem, inter_cand, ixs16, ixs20, id, titr, kxx, ixx, igeo, nod2el1d, knod2el1d, lelx, intbuf_tab, pm_stack, iworksh, nspmd)
Definition i20ini3.F:64
i21els3
subroutine i21els3(x, irects, irectm, nrts, nrtm, geo, ixs, pm, ixc, ixtg, nint, nty, noint, nsn, nsv, ieles, intth, areas, nmn, msr, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, igrsurfs, igrsurfm, ielem21, thk, as, bs, ixs10, ixs16, ixs20, id, titr, igeo, sh4tree, sh3tree, ipart, ipartc, iparttg, pm_stack, iworksh, intfric, tagprt_fric, ipartfrics, ipartfricm, intbuf_fric_tab, iparts)
Definition i21els3.F:49
i22err3
subroutine i22err3(x, nrtm, irect, itab, pm, ixs, nbric, brics, id, titr, ix1, ix2, ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, n1, n2, n3, x0, y0, z0, xn1, yn1, zn1, xn2, yn2, zn2, xn3, yn3, zn3, xn4, yn4, zn4)
Definition i22err3.F:44
i22sti3
subroutine i22sti3(stf, nrt)
Definition i22sti3.F:32
i22tzinf
subroutine i22tzinf(x, tzinf, bufbric, nbric, ixs)
Definition i22tzinf.F:32
i23buc1
subroutine i23buc1(x, irect, nsv, bumult, nseg, nmn, nrtm, mwa, nsn, cand_e, cand_n, gap, xyzm, noint, i_stok, dist, tzinf, maxbox, minbox, msr, stf, multimp, itab, gap_s, igap, gapmin, gapmax, inacti, nrts, irects, i_mem, iddlevel, id, titr, gap_m, prov_n, prov_e, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, n11, n21, n31, pene)
Definition i23buc3.F:56
i23gap3
subroutine i23gap3(x, irects, irectm, nrts, nrtm, geo, ixs, pm, ixc, ixtg, nint, nty, noint, nsn, nsv, intth, nmn, msr, wa, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, thk, ixs10, ixs16, ixs20, ipartc, iparttg, gap, igap, gap_s, gapmin, gapinf, gapmax, gapscale, bgapsmx, stfn, stf, id, titr, gap_m, igeo, pm_stack, iworksh)
Definition i23gap3.F:47
i23pwr3
subroutine i23pwr3(itab, inacti, cand_e, cand_n, stfn, x, i_stok, nsv, iwpene, pene, noint, nty, gap_s, msr, irect, gapmin, gapmax, fpenmax, nsn, itag, cand_en, cand_nn, cand_p, stf, ifpen, ifpenn, gapv)
Definition i23pwr3.F:37
i24buc1
subroutine i24buc1(x, irect, nsv, bumult, nseg, nmn, nrtm, mwa, nsn, cand_e, cand_n, gap, xyzm, noint, i_stok, dist, tzinf, maxbox, minbox, msr, stf, stfn, multimp, istf, iddlevel, itab, gap_s, gap_m, igap, gapmin, gapmax, inacti, gap_s_l, gap_m_l, i_mem, marge, id, titr, nbinflg, mbinflg, ilev, msegtyp, gap_n, mvoisn, ixs, ixs10, ixs16, ixs20, ipartns, ipen0, penmax, irtse, is2se, is2pt, xfic, nrtse, nsne, prov_n, prov_e, nsvg, ix1, ix2, ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, stif, pene, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, n11, n21, n31, dgapload, s_kremnode, s_remnode, kremnode, remnode, flag_removed_node)
Definition i24buc1.F:64
i24ini_gap_n
subroutine i24ini_gap_n(nrtm, irect, ixs, geo, ixc, ixtg, ixt, ixp, ipart, ipartc, iparttg, thk, thk_part, nvoisin, gap_n, gap_m, nmn, msr, gapn_m, gap_n0, intply, gapmax_m, igeo, msegtyp)
Definition i24inisu_nei.F:423
i24inisur_nei
subroutine i24inisur_nei(nrtm, nsn, irect, irtlm, mvoisin, nvoisin, mseglo, msegtyp, itab, x, id, titr, igeo)
Definition i24inisu_nei.F:35
i24pwr3
subroutine i24pwr3(itab, inacti, cand_e, cand_n, pmin, penmin, i_stok, nsv, iwpene, pene_old, noint, nty, msr, irtlm, irect, nsn, id, titr, icont_i, iwpene0)
Definition i24pwr3.F:36
i24ll_kg
subroutine i24ll_kg(x, irect, ixs, pm, wa, geo, nrt, ixc, nint, nty, noint, nsn, nsv, ixtg, ixt, ixp, ipart, ipartc, iparttg, thk, thk_part, ixr, itab, ixs10, ixs16, ixs20, nmn, msr, ll_s, ll_m, ipartt, ipartp, ipartr, igeo)
Definition i24sti3.F:2061
i24sti3
subroutine i24sti3(x, irect, stf, ixs, pm, geo, nrt, ixc, nint, stfac, nty, gap, noint, stfn, nsn, ms, nsv, ixtg, igap, wa, gap_s, gap_m, gapmin, ixt, ixp, gapinf, gapmax_s, inacti, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, igrsurf, intth, ieles, ielec, areas, sh4tree, sh3tree, ipart, ipartc, iparttg, thk, thk_part, ixr, itab, bgapsmx, ixs10, msegtyp, nrt_sh, ixs16, ixs20, gap_n, mvoisn, ilev, igrsurf2, gapmax_m, id, titr, igap0, pen_old, ipartns, iparts, igeo, fillsol, pm_stack, iworksh, intfric, tagprt_fric, ipartfrics, ipartfricm, intbuf_fric_tab, intnitsche, nrts, irects, ielnrts, adrects, facnrts, nmn, msr, ipartt, ipartp, ipartr, elem_linked_to_segment, igsti, flag_elem_inter25)
Definition i24sti3.F:55
i24fici_ini
subroutine i24fici_ini(irtse, nsne, is2se, nsv, is2pt, nsn, fic_i)
Definition i24surfi.F:1723
i24fics_ini
subroutine i24fics_ini(irtse, nsne, is2se, nsv, is2pt, nsn, fic_s)
Definition i24surfi.F:1653
i24isegpt_ini
subroutine i24isegpt_ini(irtse, nsne, is2se, nsv, is2pt, nsn, isegpt, npt, ispt2)
Definition i24surfi.F:1794
i24ficv_ini
subroutine i24ficv_ini(irtse, nsne, is2se, nsv, is2pt, nsn, fic_v, npt)
Definition i24surfi.F:1969
ispt2_ini
subroutine ispt2_ini(cand_n, i_stok, nsn, irtlm, isegpt, ispt2)
Definition i24surfi.F:1870
i25buc_vox1
subroutine i25buc_vox1(x, irect, nsv, bumult, nmn, nrtm, nsn, intbuf_tab, gap, i_stok, dist, tzinf, maxbox, minbox, msr, stf, stfn, iddlevel, gap_s, gap_m, igap, gapmin, gapmax, inacti, gap_s_l, gap_m_l, marge, id, titr, nbinflg, mbinflg, ilev, msegtyp, gap_n, bgapsmx, iparts, knod2els, nod2els, kremnode, remnode, ixs, ixs10, ixs16, ixs20, icode, iskew, drad, dgapload, nrtmt, flag_removed_node, ielem_m, nin, npari, ipari)
Definition i25buc_vox1.F:52
i25neigh
subroutine i25neigh(nrtm, nsn, nsv, irect, irtlm, mvoisin, evoisin, mseglo, msegtyp, itab, x, id, titr, igeo, nadmsr, admsr, adskyn, iadnor, nrtm_sh, iedge, nedge, ledge, lbound, edg_cos, nisub, lisub, addsubm, lisubm, inflg_subm, nisube, addsube, lisube, inflg_sube, noint, nmn, msr, nom_opt, ilev, mbinflg, ebinflg, ielem_m, idel_solid)
Definition i25neigh.F:45
i25ini_gap_n
subroutine i25ini_gap_n(nrtm, irect, ixs, geo, ixc, ixtg, ixt, ixp, ipart, ipartc, iparttg, thk, thk_part, gap_n, gap_m, nmn, msr, gapn_m, gapmax_m, gapscale, igeo, msegtyp, gapmsav, ithk25, igap, thk_m, thk_m_scale)
Definition i25neigh.F:1139
i25norm
subroutine i25norm(nrtm, irectm, numnod, x, nod_normal, nmn, msr, itab, nrtm0, msegtyp, mvoisin, evoisin, nedge, ledge, lbound, admsr, vtx_bisector, e2s_nod_normal, nadmsr, iedge, ielem_m)
Definition i25norm3.F:45
i25pen3e
subroutine i25pen3e(jlt, iedge, cand_s, cand_m, n1, n2, m1, m2, xxs1, xxs2, xys1, xys2, xzs1, xzs2, xxm1, xxm2, xym1, xym2, xzm1, xzm2, gapve, pene, ex, ey, ez, fx, fy, fz, ledge, irect, x, itab)
Definition i25pen3e.F:36
i25pwr3
subroutine i25pwr3(itab, inacti, cand_e, cand_n, stfn, x, i_stok, nsv, iwpene, pene_old, noint, nty, msr, irtlm, irect, nsn, id, titr, mseglo, icont_i, iwpene0, penmin, iresp)
Definition i25pwr3.F:37
i25cand
subroutine i25cand(cand_e, cand_n, nsn, irtlm, ii_stok, nrtm, msegtyp)
Definition i25pwr3.F:154
i25pwr3_e2s
subroutine i25pwr3_e2s(itab, inacti, cand_m, cand_s, istok, llt, pene, iwpene, cand_p, n1, n2, m1, m2, noint, nty, irect, id, titr, cand_m_g, cand_s_g, cand_p_g)
Definition i25pwr3_e2s.F:37
i25pwr3e
subroutine i25pwr3e(itab, inacti, cand_m, cand_s, istok, llt, pene, iwpene, cand_p, n1, n2, m1, m2, noint, nty, irect, id, titr, cand_m_g, cand_s_g, cand_p_g, iedge, nledge, nedge, ledge)
Definition i25pwr3e.F:38
i25remline
subroutine i25remline(x, nedge, ledge, numnod, gap_e, gap_e_l, igap0, igap, drad, bgapemx, bgapemx_l, kremnode, remnode, nremnode, i_start, i_mem_rem, inod2lin, tagsecnd, nod2lin, dgapload, perm, perm_inv, gap_maxneigh)
Definition i25remlin.F:37
i25sors
subroutine i25sors(nsn, nrts, itab, ilev, ipari, intbuf_tab)
Definition i25sors.F:34
i25sti3
subroutine i25sti3(x, irect, stf, ixs, pm, geo, nrt, ixc, nint, stfac, nty, gap, noint, stfn, nsn, ms, nsv, ixtg, igap, wa, gap_s, gap_m, gapmin, gapscale, ixt, ixp, gapinf, gapmax_s, inacti, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, intth, ieles, ielem, areas, sh4tree, sh3tree, ipart, ipartc, iparttg, thk, thk_part, ixr, itab, bgapsmx, ixs10, msegtyp, nrt_sh, ixs16, ixs20, gap_n, ilev, gapmax_m, id, titr, igap0, pen_old, iparts, igeo, fillsol, pm_stack, iworksh, percent_size, gap_s_l, gap_m_l, knod2el1d, nod2el1d, intfric, tagprt_fric, ipartfrics, ipartfricm, intbuf_fric_tab, ivis2, gapm_mx, gaps_mx, gapm_l_mx, gaps_l_mx, ipartsm, drad, ipartt, ipartp, ipartr, ielem_m, idel_solid, elem_linked_to_segment, nin25, flag_elem_inter25, thk_s, thk_m, thk_s_scale, thk_m_scale)
Definition i25sti3.F:59
i25sti_edg
subroutine i25sti_edg(nedge, ledge, stfe, stfm, igap, gape, gap_e_l, gap_m, gap_m_l, gap_s_l, bgapemx, intfric, ipartfric_e, ipartfricm, ipartsm, bgapemx_l, nsn, nsv)
Definition i25sti_edg.F:34
i2buc1
subroutine i2buc1(x, irect, nsv, nseg, irtl, nmn, nrtm, mwa, nsn, xyzm, noint, msr, st, dmin, tzinf05, ignore, thk, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, nint, ixc, ixtg, thk_part, ipartc, geo, ixs, ixs10, pm, ixs16, ixs20, iparttg, id, titr, igeo, stack, iworksh, ix1, ix2, ix3, ix4, nsvg, prov_n, prov_e, n11, n12, n13, x1, x2, x3, x4, stif, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, s, t, ilev)
Definition i2buc1.F:60
i2chk3
subroutine i2chk3(x, irect, ixs, nrt, ixc, nint, nsn, nsv, noint, ixtg, irtl, st, dmin, geo, pm, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, igrsurf, thk, nty, ixs10, ixs16, ixs20, igeo, pm_stack, iworksh)
Definition i2chk3.F:43
i2main
subroutine i2main(nsv, msr, irectm, ipari, tag, msru, intbuf_tab)
Definition i2master.F:33
i2surfs
subroutine i2surfs(x, nsv, area, nsn, itab, ixc, ixtg, ixs, knod2els, nod2els, knod2elc, nod2elc, knod2eltg, nod2eltg, ilev, id, titr)
Definition i2surfs.F:38
i2tid3
subroutine i2tid3(x, irect, st, msr, nsv, irtl, itab, ikine, ikine1, dmin, ipari, tzinf, iddlevel, id, titr, intbuf_tab, dsearch, iproj, ixs, ixc, ixs10, ixs16, ixs20, stb, nsn_multi_connec, t2_add_connec, t2_nb_connec, t2_connec, ixtg)
Definition i2tid3.F:40
i5pwr3
subroutine i5pwr3(x, irect, msr, nsv, iloc, irtl, cst, irtl0, gap, nsn, itab, inacti)
Definition i3pen3.F:139
i3pen3
subroutine i3pen3(x, irect, msr, nsv, iloc, irtl, cst, irtl0, gap, nsn, itab, iwpene, id, titr)
Definition i3pen3.F:38
i3sti3
subroutine i3sti3(x, irect, stf, ixs, pm, geo, nrt, ixc, stfn, nseg, lnsv, nint, nsn, nsv, slsfac, nty, gap, noint, ixtg, ir, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, igrsurf, thk, ixs10, ixs16, ixs20, id, titr, gapn, stf8, depth, fmax, igeo, fillsol, pm_stack, iworksh)
Definition i3sti3.F:49
i7buc1
subroutine i7buc1(x, irect, nsv, bumult, nseg, nmn, nrtm, mwa, nsn, cand_e, cand_n, gap, xyzm, noint, i_stok, dist, tzinf, maxbox, minbox, msr, stf, stfn, multimp, istf, iddlevel, itab, gap_s, gap_m, igap, gapmin, gapmax, inacti, gap_s_l, gap_m_l, i_mem, id, titr, it19, prov_n, prov_e, nsvg, ix1, ix2, ix3, ix4, n11, n12, n13, pene, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, stif)
Definition i7buc1.F:58
i7buc_vox1
subroutine i7buc_vox1(x, irect, nsv, bumult, nseg, nmn, nrtm, mwa, nsn, gap, xyzm, noint, i_stok, dist, tzinf, msr, stf, stfn, multimp, istf, iddlevel, itab, gap_s, gap_m, igap, gapmin, gapmax, inacti, gap_s_l, gap_m_l, i_mem, ncont, icurv, bgapsmx, id, titr, drad, intercep, nin, iremnode, flagremnode, kremnode, remnode, dgapload, npari, ipari, intbuf_tab, is_used_with_law151)
Definition i7buc_vox1.F:49
i7err3
subroutine i7err3(x, nrtm, irect, noint, itab, id, titr, ix1, ix2, ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, n1, n2, n3, x0, y0, z0, xn1, yn1, zn1, xn2, yn2, zn2, xn3, yn3, zn3, xn4, yn4, zn4)
Definition i7err3.F:42
i7pwr3
subroutine i7pwr3(itab, inacti, cand_e, cand_n, stfn, stf, x, nsv, iwpene, cand_p, cand_en, cand_nn, tag, noint, gapv, nty, itied, fpenmax, id, titr, iddlevel, iremnode, kremnode, remnode, istok, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, n1, n2, n3, pene)
Definition i7pwr3.F:43
remn_i2op
subroutine remn_i2op(lower_bound, upper_bound, ipari, intbuf_tab, itab, nom_opt, nremov, iddlevel, skip_type25_edge_2_edge)
Definition i7remnode.F:675
i7remnode
subroutine i7remnode(iremnode, noint, titr, intbuf_tab, numnod, x, nrtm, irect, nsv, nsn, itab, gap_s, gap_m, gapmin, gapmax, gap_s_l, gap_m_l, igap, gap, drad, nremnode, nty, ipari, i_mem_rem, gapm_mx, gaps_mx, gapm_l_mx, gaps_l_mx, ilev, nbinflg, mbinflg, dgapload, npari)
Definition i7remnode.F:43
i7sti3
subroutine i7sti3(x, irect, stf, ixs, pm, geo, nrt, ixc, nint, stfac, nty, gap, noint, stfn, nsn, ms, nsv, ixtg, igap, wa, gap_s, gap_m, gapmin, ixt, ixp, gapinf, gapmax, inacti, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, igrsurf, intth, ieles, ielec, areas, sh4tree, sh3tree, ipart, ipartc, iparttg, thk, thk_part, percent_size, gap_s_l, gap_m_l, nod2el1d, knod2el1d, ixr, itab, bgapsmx, ixs10, ixs16, ixs20, id, titr, iddlevel, drad, igeo, fillsol, pm_stack, iworksh, it19, kxig3d, ixig3d, intfric, iparts, tagprt_fric, ipartfrics, ipartfricm, intbuf_fric_tab, nrt_ige, irem_gap, gapm_mx, gaps_mx, gapm_l_mx, gaps_l_mx, ipartt, ipartp, ipartr, elem_linked_to_segment, flag_elem_inter25)
Definition i7sti3.F:60
i9sti3
subroutine i9sti3(x, irect, stf, ixs, nrt, nint, nsn, nsv, noint, iele, knod2els, nod2els, igrsurf, isu, ixs10, ixs16, ixs20, id, titr)
Definition i9sti3.F:42
inint0
subroutine inint0(x, irect, nseg, nod2seg, nsv, msr, iloc, nmn, nsn, nrt, sirect, s_n2seg)
Definition inint0.F:32
inint0_8
subroutine inint0_8(x, irect, nseg, lcseg, nsv, msr, iloc, nmn, nsn, nrt, numnod)
Definition inint0_8.F:31
inint3
subroutine inint3(inscr, x, ixs, ixc, pm, geo, ipari, nin, itab, ms, mwa, rwa, ixtg, iwrn, ikine, ixt, ixp, ixr, nelemint, iddlevel, ifiend, ale_connectivity, nsnet, nmnet, igrbric, iwcont, nsnt, nmnt, nsn2t, nmn2t, iwcin2, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, igrsurf, ikine1, ielem21, sh4tree, sh3tree, ipart, ipartc, iparttg, thk, thk_part, nod2el1d, knod2el1d, ixs10, i_mem, resort, inter_cand, ixs16, ixs20, id, titr, iremnode, nremnode, iparts, kxx, ixx, igeo, intercep, lelx, intbuf_tab, fillsol, stack, iworksh, kxig3d, ixig3d, tagprt_fric, intbuf_fric_tab, ipartt, ipartp, ipartx, ipartr, nsn_multi_connec, t2_add_connec, t2_nb_connec, t2_connec, nom_opt, icode, iskew, iremnode_edg, s_append_array, x_append, mass_append, n2d, flag_removed_node, nspmd, inter_type2_number, elem_linked_to_segment, sinscr, sicode, sitab, nin25, flag_elem_inter25, multi_fvm, iresp)
Definition inint3.F:147
inintr
subroutine inintr(ipari, inscr, x, v, ixs, ixq, ixc, pm, geo, itab, ms, mwa, rwa, ixtg, ikine, ixt, ixp, ixr, ale_connectivity, nelemint, iddlevel, ifiend, igrbric, iwcont, iwcin2, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, igrsurf, ielem21, sh4tree, sh3tree, ipart, ipartc, iparttg, thk, thk_part, nod2el1d, knod2el1d, ixs10, inter_cand, frigap, ixs16, ixs20, ipm, nom_opt, iparts, siskwn, kxx, ixx, igeo, intercep, lelx, intbuf_tab, fillsol, stack, iworksh, nsnt, nmnt, kxig3d, ixig3d, knod2elq, nod2elq, segquadfr, tagprt_fric, intbuf_fric_tab, ipartt, ipartp, ipartx, ipartr, nsn_multi_connec, t2_nb_connec, sicode, icode, iskew, multi_fvm, s_nod2els, sitab, sitabm1, flag_elem_inter25, list_nin25, iresp)
Definition inintr.F:65
invoi3
subroutine invoi3(x, irect, lmsr, msr, nsv, iloc, irtl, nseg, nsn, nmn, itab, id, titr, nrt)
Definition invoi3.F:35
iwcontdd_type24
subroutine iwcontdd_type24(numnod, nsn, nmn, nsv, msr, iwcont, nsnt, nmnt, intbuf_tab)
Definition iwcontdd_type24.F:32
iwcontdd_type25
subroutine iwcontdd_type25(nledge, numnod, nsn, nmn, iedge, nrtm, nedge, nsv, msr, irect, iwcont, nsnt, nmnt, intbuf_tab)
Definition iwcontdd_type25.F:30
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
ale_connectivity_mod
Definition ale_connectivity_mod.F:225
front_mod
Definition front_mod.F:84
groupdef_mod
Definition groupdef_mod.F:668
inter_cand_mod
Definition inter_cand_mod.F:38
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
stack_mod
Definition stack_mod.F:75
i11dst3
subroutine i11dst3(jlt, gap, cand_s, cand_m, irects, irectm, nx, ny, nz, n1, n2, m1, m2, jlt_new, x, igap, gap_s, gap_m, gapv2, gap_s_l, gap_m_l, drad, dgapload)
Definition i11dst3.F:33
i23dst3
subroutine i23dst3(jlt, cand_n, cand_e, irect, nsv, gap_s, x, msr, pene, ifpen, igap, gap, gapmax, gapmin, gapv, gap_m)
Definition i23dst3.F:33
i24cor3
subroutine i24cor3(x, irect, nsv, cand_e, cand_n, stf, stfn, gapv, igap, gap, gap_s, gap_m)
Definition i24cor3.F:31
i24pen3
subroutine i24pen3(x, irect, gapv, cand_e, cand_n, nsv, inacti, itab, tag, iwpene, nsn, irtlm, msegtyp, iwpene0, pmin, gap_n, mvoisn, ixs, ixs10, ixs16, ixs20, penmax, penmin, id, titr, ilev, pen_old, knod2els, nod2els, ipartns, ipen0, icont_i, xfic, nrtm, irtse, is2se)
Definition i24pen3.F:46
i24cand
subroutine i24cand(cand_e, cand_n, nsn, irtlm, ii_stok, msegtyp)
Definition i24pen3.F:733
i25buce_edg
subroutine i25buce_edg(x, irect, inacti, nsn, nmn, candm_e2e, cands_e2e, gap, noint, ii_stok, mulnsne, bminma, marge, vmaxdt, drad, eshift, nedge_t, sshift, nrtm_t, stfm, stfn, ncont, gap_m, itask, bgapemx, i_mem, itab, mbinflg, ebinflg, ll_stok, mulnsns, ilev, cand_a, cand_p, igap0, flagremnode, kremnod, remnod, s_remnode_edg, igap, gap_m_l, iedge, nedge, msegtyp, ledge, admsr, edg_bisector, vtx_bisector, candm_e2s, cands_e2s, cand_b, cand_ps, gape, gap_e_l, dgapload, flag_removed_node, s_kremnode_e2s, s_remnode_e2s, kremnode_e2s, remnode_e2s, s_kremnode_edg)
Definition i25buce_edg.F:49
i25cor3
subroutine i25cor3(jlt, igap, x, irect, nsv, cand_e, cand_n, xi, yi, zi, ix1, ix2, ix3, ix4, nsvg, nsn, gap_s, gaps, admsr, nod_normal, x1, x2, x3, x4, x0, y1, y2, y3, y4, y0, z1, z2, z3, z4, z0, nnx, nny, nnz, mvoisin, mvoisn, gap_m, gapm, gap_nm, gapnm, gap_s_l, gap_m_l, gapmxl, lbound, ibound)
Definition i25cor3.F:39
i25cor3_e2s
subroutine i25cor3_e2s(jlt, ledge, irect, x, cand_s, cand_m, ex, ey, ez, xxs1, xxs2, xys1, xys2, xzs1, xzs2, xxm1, xxm2, xym1, xym2, xzm1, xzm2, n1, n2, m1, m2, nrts, gape, gapve, fx, fy, fz, iedge, admsr, lbound, edg_bisector, vtx_bisector, itab)
Definition i25cor3_e2s.F:40
i25cor3e
subroutine i25cor3e(jlt, ledge, irect, x, cand_s, cand_m, xxs1, xxs2, xys1, xys2, xzs1, xzs2, xxm1, xxm2, xym1, xym2, xzm1, xzm2, ex, ey, ez, fx, fy, fz, n1, n2, m1, m2, nedge, gape, gapve, iedge, admsr, lbound, edg_bisector, vtx_bisector, itab, igap0, igap, gap_e_l)
Definition i25cor3e.F:42
i25dst3_e2s
subroutine i25dst3_e2s(jlt, iedge, cand_s, cand_m, n1, n2, m1, m2, xxs1, xxs2, xys1, xys2, xzs1, xzs2, xxm1, xxm2, xym1, xym2, xzm1, xzm2, gapve, pene, ex, ey, ez, fx, fy, fz, ledge, irect, x, itab, e2s_nod_normal, admsr)
Definition i25dst3_e2s.F:37
i25pen3
subroutine i25pen3(jlt, cand_n, cand_e, penmin, penmax, x1, x2, x3, x4, x0, y1, y2, y3, y4, y0, z1, z2, z3, z4, z0, xi, yi, zi, nsn, ix1, ix2, ix3, ix4, nsvg, nrtm, mseglo, gaps, irect, irtlm, time_s, pene_old, itab, msegtyp, isharp, nnx, nny, nnz, gap_nm, mvoisn, gapmxl, ivis2, ibound, vtx_bisector, ilev, inacti)
Definition i25pen3.F:43
i7cor3
subroutine i7cor3(x, irect, nsv, cand_e, cand_n, stf, stfn, gapv, igap, gap, gap_s, gap_m, istf, gapmin, gapmax, gap_s_l, gap_m_l, drad, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, stif, dgapload, last)
Definition i7cor3.F:43
i7dst3
subroutine i7dst3(ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, last)
Definition i7dst3.F:46
i7pen3
subroutine i7pen3(marge, gapv, n1, n2, n3, pene, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, last)
Definition i7pen3.F:43
in12r
subroutine in12r(x, frigap, nsv, nsn, flag)
Definition in12r.F:30
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:895
bidon
subroutine bidon
Definition machine.F:41
starter
program starter
Definition starter.F:39
ale_connectivity_mod::t_ale_connectivity
Definition ale_connectivity_mod.F:256
inter_cand_mod::inter_cand_
Definition inter_cand_mod.F:40
stack_mod::stack_ply
Definition stack_mod.F:85
update_weight_inter_type11
subroutine update_weight_inter_type11(nelemint, interface_id, nrts, nrtm, ifiend, irectm, irects, i_stok, cand_e, cand_n, inter_cand)
Definition update_weight_inter_type11.F:33
update_weight_inter_type2
subroutine update_weight_inter_type2(nelemint, interface_id, nsn, nrtm, ifiend, n2d, irect, nsv, irtl, inter_cand)
Definition update_weight_inter_type2.F:32
update_weight_inter_type7
subroutine update_weight_inter_type7(nelemint, interface_id, nsn, nrtm, ifiend, irect, nsv, i_stok, cand_e, cand_n, igap, gap, gapmax, gapmin, dgapload, drad, gap_s, gap_s_l, gap_m, gap_m_l, numnod, x, inter_cand)
Definition update_weight_inter_type7.F:36
update_weight_inter_type_24_25
subroutine update_weight_inter_type_24_25(numnod, nelemint, interface_id, nsn, nrtm, ifiend, irect, nsv, i_stok, cand_e, cand_n, dgapload, gap_s, gap_m, x, inter_cand, inter_kind, intbuf_tab, iedge, nledge)
Definition update_weight_inter_type_24_25.F:36
upgrade_ixint
subroutine upgrade_ixint(inter_cand, nelemint, new_size)
Definition upgrade_ixint.F:33
upgrade_lcand_edg
subroutine upgrade_lcand_edg(ni, multimp_parameter, intbuf_tab)
Definition upgrade_multimp.F:1321
upgrade_lcand_e2s
subroutine upgrade_lcand_e2s(ni, multimp_parameter, intbuf_tab)
Definition upgrade_multimp.F:1523
upgrade_remnode_edg
subroutine upgrade_remnode_edg(ipari, nremnode, intbuf_tab)
Definition upgrade_remnode.F:225
upgrade_remnode
subroutine upgrade_remnode(ipari, nremnode, intbuf_tab, nty)
Definition upgrade_remnode.F:33