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