OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lecint.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!|| lecint ../starter/source/interfaces/interf1/lecint.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl2 ../starter/source/starter/freform.F
30!|| i20surfi ../starter/source/interfaces/inter3d1/i20surfi.F
31!|| i24surfi ../starter/source/interfaces/inter3d1/i24surfi.F
32!|| i25surfi ../starter/source/interfaces/inter3d1/i25surfi.F
33!|| i2_surfi_dim ../starter/source/interfaces/inter3d1/i2_surfi_dim.F90
34!|| ingrbric ../starter/source/interfaces/interf1/ingrbric.F
35!|| ingrbric_dx ../starter/source/interfaces/interf1/ingrbric_dx.F
36!|| ingrbric_nodes ../starter/source/interfaces/interf1/ingrbric_nodes.F
37!|| inpoint ../starter/source/interfaces/interf1/inpoint.F
38!|| inslin ../starter/source/interfaces/interf1/inslin.f
39!|| insurf ../starter/source/interfaces/interf1/insurf.F
40!|| insurf23 ../starter/source/interfaces/interf1/insurf23.F
41!|| insurf_dx ../starter/source/interfaces/interf1/insurf_dx.F
42!|| insurfigeo ../starter/source/interfaces/interf1/insurfigeo.F
43!|| inter1_check_ale_lag_sides ../starter/source/interfaces/int01/inter1_check_ale_lag_sides.F90
44!|| nintri ../starter/source/system/nintrr.F
45!|| presegmt ../starter/source/interfaces/interf1/presegmt.F
46!||--- uses -----------------------------------------------------
47!|| i2_surfi_dim_mod ../starter/source/interfaces/inter3d1/i2_surfi_dim.F90
48!|| inter1_check_ale_lag_sides_mod ../starter/source/interfaces/int01/inter1_check_ale_lag_sides.F90
49!|| message_mod ../starter/share/message_module/message_mod.F
50!|| r2r_mod ../starter/share/modules1/r2r_mod.f
51!||====================================================================
52 SUBROUTINE lecint(IPARI ,LINTER ,IPM ,BUFMAT ,
53 . NMNT ,ITAB ,ITABM1 ,GEO ,
54 . PM ,X ,IGRNOD ,IGRSURF ,IGRSLIN ,
55 . NPC ,PROBINT ,LAG_NCF ,
56 . LAG_NKF ,LAG_NCL ,LAG_NKL ,LAG_NHF ,MAXRTM ,
57 . ISKN ,MAXRTMS ,IGEO ,
58 . XFILTR ,STFAC ,FRIC_P ,FRIGAP ,
59 . I2RUPT ,AREASL ,UNITAB ,IXS ,NOM_OPT ,
60 . ITAG ,IXC ,IXTG ,KNOD2ELC,KNOD2ELTG,
61 . NOD2ELC ,NOD2ELTG,KNOD2ELS,NOD2ELS,IXS10 ,
62 . IXS16 ,IXS20 ,DEF_INTER,MAXNSNE,
63 . NPC1 ,MULTI_FVM,NOM_OPTFRIC,INTBUF_FRIC_TAB,
64 . IGRBRIC,IGRSH3N ,IGRTRUSS ,MAXRTM_T2,NSN_MULTI_CONNEC,T2_NB_CONNEC,
65 . IDDLEVEL,NALE ,INTERFACES,SNPC1 ,FLAG_ELEM_INTER25,LIST_NIN25)
66C============================================================================
67C M o d u l e s
68C-----------------------------------------------
69 USE unitab_mod
70 USE r2r_mod
71 USE message_mod
72 USE multi_fvm_mod
73 USE intbuf_fric_mod
74 USE groupdef_mod
75 USE ale_mod
76 USE interfaces_mod
77 USE names_and_titles_mod , ONLY : nchartitle
78 USE i2_surfi_dim_mod , ONLY : i2_surfi_dim
79 use inter1_check_ale_lag_sides_mod , only : inter1_check_ale_lag_sides
80 use element_mod , only : nixs
81C-----------------------------------------------
82C I m p l i c i t T y p e s
83C-----------------------------------------------
84#include "implicit_f.inc"
85C-----------------------------------------------
86C C o m m o n B l o c k s
87C-----------------------------------------------
88#include "com01_c.inc"
89#include "com04_c.inc"
90#include "units_c.inc"
91#include "param_c.inc"
92#include "scr17_c.inc"
93#include "tabsiz_c.inc"
94C-----------------------------------------------
95C D u m m y A r g u m e n t s
96C-----------------------------------------------
97 INTEGER,INTENT(IN) :: SNPC1 !< array size NPC1
98 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
99 INTEGER,INTENT(IN)::IDDLEVEL
100 INTEGER NOM_OPT(LNOPT1,*),MAXNSNE
101 INTEGER LINTER,NMNT, LAG_NCF,LAG_NKF,
102 . LAG_NCL,LAG_NKL,LAG_NHF,MAXRTM,MAXRTMS, NBRIC
103 INTEGER IPARI(NPARI,NINTER), ITAB(SITAB), ITABM1(SITABM1),
104 . NPC(SNPC),ISKN(SISKWN),
105 . IGEO(NPROPGI,NUMGEO),IXS(NIXS,NUMELS),ITAG(*),
106 . IXC(*),IXTG(*),KNOD2ELC(*),KNOD2ELTG(*),
107 . NOD2ELC(*),NOD2ELTG(*),KNOD2ELS(*),NOD2ELS(*),
108 . IXS10(6,*), IXS16(8,*), IXS20(12,*),DEF_INTER(100),
109 . NPC1(SNPC1),NOM_OPTFRIC(LNOPT1,*),MAXRTM_T2,
110 . t2_nb_connec(*),nsn_multi_connec
111 INTEGER, INTENT(IN) :: NALE(NUMNOD)
112 INTEGER, INTENT(INOUT) :: LIST_NIN25(NINTER)
113 INTEGER, INTENT(INOUT) :: FLAG_ELEM_INTER25(NINTER25,NUMELS)
114 my_real
115 . geo(npropg,numgeo), pm(*), xfiltr(*),stfac(*),
116 . fric_p(10,ninter),i2rupt(6,ninter),frigap(nparir,ninter),areasl(*)
117 my_real probint
118 my_real x(3,numnod)
119 TYPE(multi_fvm_struct), INTENT(IN) :: MULTI_FVM
120 TYPE(INTBUF_FRIC_STRUCT_) INTBUF_FRIC_TAB(*)
121 INTEGER,INTENT(IN) :: IPM(NPROPMI,NUMMAT)
122 my_real,INTENT(IN) :: BUFMAT(SBUFMAT)
123C-----------------------------------------------
124 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
125 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
126 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
127 TYPE (GROUP_) , DIMENSION(NGRTRUS) :: IGRTRUSS
128 TYPE (SURF_) , DIMENSION(NSURF) ,TARGET :: IGRSURF
129 TYPE (SURF_) , DIMENSION(NSLIN) ,TARGET :: IGRSLIN
130 TYPE (INTERFACES_) ,INTENT(INOUT):: INTERFACES
131C-----------------------------------------------
132C L o c a l V a r i a b l e s
133C-----------------------------------------------
134 INTEGER I,K,L,IRS,IRM,NI,NSN,NMN,
135 . ntyp,is1,is2,noint,nrts,nrtm,ibuc,ilev,
136 . multimp,igap,inacti,nme,lag_nc16,lag_nk16,
137 . ilagm,ncf_i2,nuvar,
138 . nin,nisub,jsub,igr,isu,isu1,isu2,pid,stat,
139 . nrtms,nrtmm,iallo,nlinsa,nlinma,nsne,nln,
140 . nrts_new, nrtm_new,nrtm_fe,
141 . nrtm_ige,nrtmm_ige,
142 . nrts_ige,nrtms_ige,nrts_fe,
143 . nmn_ige,nmn_fe,nsn_ige,nsn_fe,iad_ige,
144 . iedge,nconte,multimpe,multimps,istiff,nin25
145 INTEGER KD(50),JD(50),IBID,NRTM_SH,ETYP,INTPLY
146 INTEGER, DIMENSION(:), ALLOCATABLE :: IRECTS,IRECTM,NSV,MSR
147 INTEGER ID,ISL, GRBRIC_ID
148 CHARACTER(LEN=NCHARTITLE) :: TITR
149 my_real RBID,AUTO_RHO,AUTO_LENGTH, STIFF_STAT(3)
150
151 INTEGER, DIMENSION(:), ALLOCATABLE, TARGET :: NTAG_TARGET
152 INTEGER, DIMENSION(:), POINTER :: NTAG
153 INTEGER, DIMENSION(:,:), POINTER :: SURF_NODES,SURF_NODES_IGE,LINE_NODES
154 LOGICAL IS_GAP_COMPUTED,TYPE18
155 INTEGER S_MSR,S_NSV,S_IRECTS,S_IRECTM
156 CHARACTER MESS*40
157 DATA MESS/'INTERFACE INPUT '/
158C-----------------------------------------------
159C E x t e r n a l F u n c t i o n s
160C-----------------------------------------------
161 INTEGER,EXTERNAL :: NINTRI
162C--------------------------------------------
163C INTERFACE BUFFER
164C expect for Interface TYPE 14 & Interface TYPE 15
165C--------------------------------------------
166C IPARI(NPARI,NINTER) :: PARAMETER BUFFER
167C--------------------------------------------
168C 1 :JINBUF:INDEX FOR INTEGER BUFFER
169C 2 :JBUFIN:INDEX FOR REAL BUFFER
170C 3 :NRTS :NUMBER OF SECONDARY FACES
171C 4 :NRTM :NUMBER OF MAIN FACES
172C 5 :NSN :NUMBER OF SECONDARY POINTS
173C 6 :NMN :NUMBER OF MAIN POINTS
174C 7 :NTY :INTERFACE TYPE
175C 8 :NST :SIZE FOR ADJACENT SECONDARY FACES
176C 9 :NMT :SIZE FOR ADJACENT MAIN FACES
177C 10 :JINSCR:INDEX FOR SCRATCH BUFFER
178C 11 :IBC :FLAG FOR BOUNDARY CONDITIONS
179C 12 :IBUC :FLAG BUCKET SORT (EXPECT FOR TYPE 7)
180C 13 :IDEF :DEFAULT FLAG FOR INPUT TYPE (SURFACES S/M)
181C 14 :IVIS2 :VISCOSITY flag TYPE : 7, 24, 25
182C 14 :IVIS2==-1 : FLAG FOR ADHESION AT INTERFACES : 25
183C 14 :NRTM :ND DE CALCULS DE FORCE INTERFACE TYPE 4 ;
184C 15 :NOINT :USER IDENTIFIER
185C 16 : : PARALLELILZATION FLAG (INTERFACE LOOPS)
186C 17 :IDELx : SHOOTING NODES FLAG : 2,3,5,7,10,11
187C 18 :NCONT :NUMBER OF AVERAGE CONTACTS IN SPMD
188C (NCONT=NSN*NMN_L/NMN) : 7,10,11
189C 19 :ISINT :FLAG TH
190C 20 :ILEV :FORMULATION FLAG
191C 21 :IGAP :FLAG FOR VARIABLE GAP
192C 22 :INACTI:inactivation initial penetrations :(3,4,5,6)7
193C 23 :MULTIMP:number of possible multiple impact : 7,10,11
194C 24 :NSNR :NUMBER OF SECONDARY ADDITIONAL NODES
195C PROC REMOTEEN SPMD : 7,10,11
196C :IRM :RENUMBER MAIN FLAG : 3,5,6;8
197C 25 :IRS :RENUMBER SECONDARY FLAG : 3,6
198C 26 :HIERA :FLAG DE TRAITEMENT HIERARCHIE : 2 ,(12,13)
199C :NOD1 :ID Node groug : 20
200C :NB DE SHELL PARMI NRTM : 24
201C 27 :IADFIN:FIRST INDEX FOR CHAINED LIST : 11
202C 28 :INTSEC:NUMBER OF SECTION
203C 29 :ICONT :CONTACT FLAG FOR SENSORS
204C 30 :MFROT :FRICTION MODEL IDENTIFIER : 5,7,20
205C 31 :IFQ :FRICTION FILTERING FLAG : 5,7,20
206C 32 :IBAG :FLAG TOCOUPLE AIRBAG POROSIT§Y : 5,7,20
207C 33 :ILAGM :
208C 34 :IGSTI :
209C 34 :IGE : I17
210C 35 :ISTOK : I17
211C 35 :NUVAR : user property for interf 2 + rupture
212C 36 :IGN : I17
213C :NLN :total number of nodes (secondary+main+edge) 20
214C 36 :NISUB : sub interfaces 7 10 20
215C 37 :NISUBS: sub interfaces 7 10 20
216C 38 :NISUBM: sub interfaces 7 10 20
217C 39 :ICURV : fixed curvature 7 20
218C 40 :NA1 : fixed curvature 7 20
219C 41 :NA2 : fixed curvature 7 20
220C 42 :ISYME : EDGE SYMMETRY 11 20
221C 43 :PID : user property for interf 2 + rupture 2
222C :ISYM : SYMMETRICAL SURFACES 20
223C 44 :IADM : FLAG COUPLAGE ADAPTIVE MESHING 5 7 20
224C 45 :ISU1 : Secondary Gpe or Surface 20
225C 46 :ISU2 : Main Gpe or Surface 20
226C 47 :IFILTR: FILTERING FLAG (type2 with rupture)
227C :INTTH : THERMAL FLAG 7...
228C 48 :IFORM : FORMULATION FLAG 7
229C (constant temperature or contact shell&brick)
230C :IFUNS : Function ID for type 2 with rupture 2
231C 49 :IFUNN : Function ID for type 2 with rupture 2
232C 49 :NRADM:Nb of elements within an arc, if adaptive meshing.
233C 50 :IFNOR : for computing normal force 8
234C 50 :IFUNT : Function ID for type 2 with rupture
235C 51 :NLINS : NUMBER OF SECONDARY EDGES 20
236C 52 :MLINM : NUMBER OF MAIN EDGES 20
237C 53 :NLINSA: NUMBER OF ACTIVE SECONDARY EDGES 20
238C 54 :MLINMA: NUMBER OF ACTIVE MAIN EDGES 20
239C 55 :NSNE : NUMBER OF POINTS FOR SECONDARY EDGES 20
240C 56 :NMNE : NUMBER OF POINTS FOR MAIN EDGES 20
241C 57 :NSNER :NUMBER OF POINTS FOR SECONDARY EDGES(REMOTE) 20
242C 58 :IEDGE : FLAG FOR EDGE TYPE 20
243C 59 :LINE1 : ID Line 1 20
244C 60 :LINE2 : ID Line 2 20
245C 61 :IDELKEEP: Keep non-connected secondary nodes (IDEL) 3,5,7,10,11,20,21,23,24
246C
247C 73 :NRTM_IGE :NUMBER OF FACE ISOGEOMETRIC MAIN
248C 74 :NRTM_FE :NUMBER OF FACE FINITE ELEMENT MAIN
249C 75 :NTRS_IGE :NUMBER OF FACE ISOGEOMETRIC SECONDS
250C 76 :NTRS_FE :NUMBER OF FACE FINITE ELEMENT SECONDS
251C 77 :NSN_IGE :NUMBER OF POINTS ISOGEOMETRIC SECONDS
252C 78 :NSN_FE :NUMBER OF POINTS FINITE ELEMENT SECONDS
253C 79 :NMN_IGE :NUMBER OF POINTS ISOGEOMETRIC MAINS
254C 80 :NMN_FE :NUMBER OF POINTS FINITE ELEMENT MAINS
255C=======================================================================
256C-----------------------------------------------
257C S o u r c e L i n e s
258C-----------------------------------------------
259 ALLOCATE(ntag_target(2*numnod+1), stat=stat)
260 ntag(0:2*numnod) => ntag_target(1:2*numnod+1)
261
262 DO k=0,2*numnod
263 ntag(k) = 0
264 ENDDO
265
266 lag_nc16 = 0
267 lag_nk16 = 0
268 imaximp = 0
269 maxrtm = 0
270 maxrtms = 0
271 maxrtm_t2 = 0
272 nrtms = 0
273 nrtmm = 0
274 nmnt = 0
275 nrtmm_ige = 0
276 nrtms_ige = 0
277 stiff_stat = zero
278 nin25 = 0
279
280 DO ni=1,linter
281C
282 igap = ipari(21,ni)
283 inacti = ipari(22,ni)
284 multimp = ipari(23,ni)
285 iedge = ipari(58,ni)
286 multimpe= ipari(87,ni)
287 multimps= ipari(89,ni)
288 ntyp = ipari(07,ni)
289 is1 = ipari(13,ni)/10
290 is2 = mod(ipari(13,ni),10)
291 noint = ipari(15,ni)
292 isu1 = ipari(45,ni)
293 isu2 = ipari(46,ni)
294 istiff = ipari(29,ni)
295 ilagm = ipari(33,ni)
296 type18=.false.
297 IF(ntyp==7 .AND. inacti==7 )type18=.true.
298 grbric_id = isu1
299 IF(type18)grbric_id = ipari(83,ni)
300C----- --
301 nsn=0
302 nsn_fe=0
303 nsn_ige=0
304 nmn=0
305 nmn_fe=0
306 nmn_ige=0
307 nrts=0
308 nrts_ige=0
309 nrts_fe =0
310 nrtm=0
311 nrtm_ige=0
312 nrtm_fe =0
313 IF(is1 == 1)THEN
314 nrts_ige=igrsurf(isu1)%NSEG_IGE
315 nrts_fe =igrsurf(isu1)%NSEG
316 nrts = nrts_fe + nrts_ige
317 ELSEIF(is1 == 2) THEN
318 nsn_fe=igrnod(isu1)%NENTITY
319 nsn = nsn_fe
320 ELSEIF(is1 == 3)THEN
321 nrts_fe=igrslin(isu1)%NSEG
322 nrts = nrts_fe
323 ELSEIF(is1 == 4)THEN
324 nsn=0
325 ELSEIF(is1 == 5) THEN
326 nsn_fe=igrbric(isu1)%NENTITY
327 nsn = nsn_fe
328 ENDIF
329 IF(is2 == 1)THEN
330 nrtm_ige=igrsurf(isu2)%NSEG_IGE
331 nrtm_fe =igrsurf(isu2)%NSEG
332 nrtm = nrtm_fe + nrtm_ige
333 ELSEIF(is2 == 3)THEN
334 nrtm_fe=igrslin(isu2)%NSEG
335 nrtm = nrtm_fe
336 ELSEIF(is2 == 4)THEN
337 nrtm_ige=igrsurf(isu2)%NSEG_IGE
338 nrtm_fe=igrsurf(isu2)%NSEG
339 nrtm = nrtm_fe + nrtm_ige
340C IS2=4 is Input by Surface Type of
341C ISURF(4,NS) == 100 Hyper-Ellipsoid MaDyMo coupled with.
342C ISURF(4,NS) == 101 Hyper-Ellipsoid Radioss defined.
343C IS2=4 is available for Interface TYPE 14 only :
344C should be checked for all others interfaces in LECIN4 ...
345 ENDIF
346C
347 ipari(3,ni) = nrts
348 ipari(6,ni) = nmn
349 ipari(4,ni) = nrtm
350 ipari(5,ni) = nsn
351 ipari(73,ni) = nrtm_ige
352 ipari(74,ni) = nrtm_fe
353 ipari(75,ni) = nrts_ige
354 ipari(76,ni) = nrts_fe
355 ipari(77,ni) = nsn_ige
356 ipari(78,ni) = nsn_fe
357 ipari(79,ni) = nmn_ige
358 ipari(80,ni) = nmn_fe
359C
360 IF (ntyp == 2 .AND. is1==-1.AND. is2==-1) THEN
361 CALL i2_surfi_dim( npari ,ipari(1,ni),nsurf ,igrsurf ,
362 1 nsn ,nrtm ,nmn ,frigap(4,ni) ,
363 2 x ,numnod )
364 ipari(4,ni) = nrtm
365 ipari(5,ni) = nsn
366 ipari(6,ni) = nmn
367 ipari(78,ni) = nsn
368 ipari(74,ni) = nrtm
369 ELSEIF (ntyp == 14) THEN
370 nmnt = max(nmnt,4*numnod)
371 ELSEIF (ntyp == 15) THEN
372 nmnt = max(nmnt,9*numnod+12*numels+2*numelc+2*numeltg)
373 ELSEIF(ntyp == 16)THEN
374 nsn =igrnod(isu1)%NENTITY
375 nme =igrbric(isu2)%NENTITY
376 ipari(4,ni)=nme
377 ipari(5,ni)=nsn
378 ipari(36,ni)=isu1
379 ipari(34,ni)=isu2
380 lag_nc16 = numnod
381 lag_nk16 = numnod*51
382 nmnt = max(nmnt,4*(nme+100)+ 2*nsn )
383 ELSEIF(ntyp == 17)THEN
384 nsn =igrbric(isu1)%NENTITY
385 nme =igrbric(isu2)%NENTITY
386 ipari(4,ni)=nme
387 ipari(5,ni)=nsn
388 ipari(36,ni)=isu1
389 ipari(34,ni)=isu2
390 nmnt = max(nmnt, 4*(nme+100)+ 4*(nsn+100))
391 IF(ipari(33,ni)==0)THEN
392 imaximp = imaximp + (multimp*nsn*16)/5 + 1
393 ELSE
394 lag_nc16 = numnod
395 lag_nk16 = numnod*51
396 ENDIF
397C--------
398C n_mul_mx et l_mul_lag are overestimated
399c NKMAX = 51
400c N_MUL_MX = NUMNOD
401c N_MUL_MX_I = NUMNOD
402c N_BCS = 0
403c NH = N_MUL_MX * 5
404c NMNT =MAX(NMNT,8*(NME+100) + (1+4*NKMAX) * N_MUL_MX_I + 6*(NUMELS16+NUMELS20))
405c L_MUL_LAG = MAX(L_MUL_LAG,(1+4*NKMAX)*N_MUL_MX_I + 6 * (NUMELS16+NUMELS20),(1+4*NKMAX)*N_MUL_MX_I + 5*N_MUL_MX + 3*NUMNOD + 2*NH)
406C--------
407 ELSEIF(ntyp == 20)THEN
408 iallo = 1 ! memory estimation
409 CALL i20surfi(iallo ,ipari(1,ni),igrnod ,igrsurf ,
410 2 igrslin ,ibid ,frigap(1,ni),
411 3 ibid ,ibid ,ibid ,ibid ,
412 4 ibid ,ibid ,ibid ,ibid ,
413 5 ibid ,ibid ,x ,ibid ,
414 6 ibid )
415 nrts = ipari(3,ni)
416 nmn = ipari(6,ni)
417 nrtm = ipari(4,ni)
418 nsn = ipari(5,ni)
419 nln = ipari(35,ni)
420
421 ELSEIF(ntyp == 24)THEN
422 iallo = 1 ! memory estimation
423 CALL i24surfi(
424 1 iallo ,ipari(1,ni) ,igrnod ,igrsurf ,
425 2 ibid ,frigap(1,ni) ,
426 3 ibid ,ibid ,itab ,x ,
427 4 ibid ,ibid ,ibid ,ibid ,
428 5 ibid ,itag ,intply ,ixc ,
429 6 ixtg ,knod2elc ,knod2eltg ,nod2elc ,
430 7 nod2eltg ,knod2els ,nod2els ,ixs ,
431 8 ixs10 ,ixs16 ,ixs20 ,ibid ,
432 9 ibid ,ibid ,ibid ,ipari(86,ni) )
433 intply= ipari(66,ni)
434 IF(intply > 0) intplyxfem = 1
435C----------NRTS,NRTM is calculated in I24SURFI
436C--------------number of shell seg is not doubled yet for NRTM
437 nrtm = ipari(4,ni)
438C!!!!!re-calculate NRTM_SH taking into account to ISU1 :inside I24SURFI
439 nrts = ipari(3,ni)
440 nmn = ipari(6,ni)
441 nsn = ipari(5,ni)
442 nln = ipari(35,ni)
443 nrtm_sh=ipari(42,ni)
444C
445 ELSEIF(ntyp == 25)THEN
446 iallo = 1 ! memory evaluation
447 intply = 0
448 nin25 = nin25 + 1
449 list_nin25(ni) = nin25
450 CALL i25surfi(
451 1 iallo ,ipari(1,ni) ,igrnod ,igrsurf ,
452 2 ibid ,frigap(1,ni) ,
453 3 ibid ,ibid ,itab ,x ,
454 4 ibid ,ibid ,ibid ,ibid ,
455 5 ibid ,itag ,intply ,ixc ,
456 6 ixtg ,knod2elc ,knod2eltg ,nod2elc ,
457 7 nod2eltg ,knod2els ,nod2els ,ixs ,
458 8 ixs10 ,ixs16 ,ixs20 ,ibid ,
459 9 ibid ,ibid ,ibid ,interfaces%PARAMETERS,
460 a nin25 ,flag_elem_inter25)
461 ipari(66,ni) = intply
462 IF(intply > 0) intplyxfem = 1
463C----------NRTS,NRTM is calculated in I25SURFI
464C--------------number of shell seg is not doubled yet for NRTM
465 nrtm = ipari(4,ni)
466C!!!!!re-calculate NRTM_SH taking into account to ISU1 :inside I25SURFI
467 nrts = ipari(3,ni)
468 nmn = ipari(6,ni)
469 nsn = ipari(5,ni)
470 nln = ipari(35,ni)
471 nrtm_sh=ipari(42,ni)
472 ENDIF
473C--------------------------------------------
474C Sizing due to sub-interfaces
475C--------------------------------------------
476 nisub=0
477C--------------------------------------------
478 IF(ntyp==25)THEN
479C--------------------------------------------
480 DO jsub=1,nintsub
481
482C Subinter : Case Inter corresponding to id inter
483
484 IF(nom_opt(2,ninter+jsub) == noint .AND. nom_opt(5,ninter+jsub) == 1)THEN
485 nisub=nisub+1
486 igr =nom_opt(4,ninter+jsub)
487 isu1 =nom_opt(3,ninter+jsub)
488 isu2 =nom_opt(6,ninter+jsub)
489 IF(igr/=0)ipari(37,ni)=ipari(37,ni)+igrnod(igr)%NENTITY
490 IF(isu2/=0)THEN
491 ipari(38,ni)=ipari(38,ni)+igrsurf(isu2)%NSEG
492 ipari(37,ni)=ipari(37,ni)+4*igrsurf(isu2)%NSEG
493 IF(iedge/=0)THEN
494 ipari(90,ni)=ipari(90,ni)+4*igrsurf(isu2)%NSEG
495 END IF
496 END IF
497 IF(isu1/=0)THEN
498 ipari(38,ni)=ipari(38,ni)+igrsurf(isu1)%NSEG
499 ipari(37,ni)=ipari(37,ni)+4*igrsurf(isu1)%NSEG
500 IF(iedge/=0)THEN
501 ipari(90,ni)=ipari(90,ni)+4*igrsurf(isu1)%NSEG
502 END IF
503 END IF
504 END IF
505
506C Subinter : Case Inter 0
507
508 IF(nom_opt(2,ninter+jsub) == 0 .AND. nom_opt(5,ninter+jsub) == 1) THEN
509 nisub=nisub+1
510 isu1 =nom_opt(3,ninter+jsub)
511 isu2 =nom_opt(6,ninter+jsub)
512 IF(isu2 /= 0 ) THEN
513 ipari(37,ni) = ipari(37,ni) + 4* igrsurf(isu2)%NSEG
514 ipari(38,ni)=ipari(38,ni)+igrsurf(isu2)%NSEG
515 IF(iedge/=0)THEN
516 ipari(90,ni)=ipari(90,ni)+4*igrsurf(isu2)%NSEG
517 END IF
518 ENDIF
519 IF(isu1 /=0 ) THEN
520 ipari(37,ni) = ipari(37,ni) + 4* igrsurf(isu1)%NSEG
521 ipari(38,ni)=ipari(38,ni)+igrsurf(isu1)%NSEG
522 IF(iedge/=0)THEN
523 ipari(90,ni)=ipari(90,ni)+4*igrsurf(isu1)%NSEG
524 END IF
525 ENDIF
526 END IF
527 END DO
528 ipari(36,ni)=nisub
529 ELSEIF(ntyp==24)THEN
530C--------------------------------------------
531 DO jsub=1,nintsub
532
533C Subinter : Case Inter corresponding to id inter
534
535 IF(nom_opt(2,ninter+jsub) == noint .AND. nom_opt(5,ninter+jsub) == 1)THEN
536 nisub=nisub+1
537 igr =nom_opt(4,ninter+jsub)
538 isu1 =nom_opt(3,ninter+jsub)
539 isu2 =nom_opt(6,ninter+jsub)
540 IF(igr/=0)ipari(37,ni)=ipari(37,ni)+igrnod(igr)%NENTITY
541 IF(isu2/=0)THEN
542 ipari(38,ni)=ipari(38,ni)+igrsurf(isu2)%NSEG
543 ipari(37,ni)=ipari(37,ni)+4*igrsurf(isu2)%NSEG
544 IF(ipari(55,ni)/=0)THEN
545 ipari(37,ni)=ipari(37,ni)+4*3*igrsurf(isu2)%NSEG
546 END IF
547 END IF
548 IF(isu1/=0)THEN
549 ipari(38,ni)=ipari(38,ni)+igrsurf(isu1)%NSEG
550 ipari(37,ni)=ipari(37,ni)+4*igrsurf(isu1)%NSEG
551 IF(ipari(55,ni)/=0)THEN
552 ipari(37,ni)=ipari(37,ni)+4*3*igrsurf(isu1)%NSEG
553 END IF
554 END IF
555 END IF
556
557C Subinter : Case Inter 0
558
559 IF(nom_opt(2,ninter+jsub) == 0 .AND. nom_opt(5,ninter+jsub) == 1) THEN
560 nisub=nisub+1
561 isu1 =nom_opt(3,ninter+jsub)
562 isu2 =nom_opt(6,ninter+jsub)
563 IF(isu2 /= 0 ) THEN
564 ipari(37,ni) = ipari(37,ni) + 4* igrsurf(isu2)%NSEG
565 ipari(38,ni)=ipari(38,ni)+igrsurf(isu2)%NSEG
566 IF(ipari(55,ni)/=0)THEN
567 ipari(37,ni)=ipari(37,ni)+4*3*igrsurf(isu2)%NSEG
568 END IF
569 ENDIF
570 IF(isu1 /=0 ) THEN
571 ipari(37,ni) = ipari(37,ni) + 4* igrsurf(isu1)%NSEG
572 ipari(38,ni)=ipari(38,ni)+igrsurf(isu1)%NSEG
573 IF(ipari(55,ni)/=0)THEN
574 ipari(37,ni)=ipari(37,ni)+4*3*igrsurf(isu1)%NSEG
575 END IF
576 ENDIF
577 END IF
578 END DO
579 ipari(36,ni)=nisub
580CSubiSubiSubi
581 ELSEIF(ntyp==7.OR.ntyp==10.OR.ntyp==20
582 . .OR.ntyp==22)THEN
583C--------------------------------------------
584
585C Subinter : Case Inter corresponding to id inter
586
587 DO jsub=1,nintsub
588 IF(nom_opt(2,ninter+jsub) == noint .AND. nom_opt(5,ninter+jsub) == 1)THEN
589 nisub=nisub+1
590 IF (ipari(71,ni) == 0) THEN
591 igr =nom_opt(4,ninter+jsub)
592 ipari(37,ni)=ipari(37,ni)+igrnod(igr)%NENTITY
593 isu =nom_opt(3,ninter+jsub)
594 ipari(38,ni)=ipari(38,ni)+igrsurf(isu)%NSEG
595 ELSEIF (ipari(71,ni) == -1) THEN
596C-- Type7 of type19
597 isu1 =nom_opt(4,ninter+jsub)
598 ipari(37,ni)=ipari(37,ni)+4*igrsurf(isu1)%NSEG
599 isu2 =nom_opt(3,ninter+jsub)
600 ipari(38,ni)=ipari(38,ni)+igrsurf(isu2)%NSEG
601 ELSE
602C-- Type7 sym of type19
603 isu1 =nom_opt(3,ninter+jsub)
604 ipari(37,ni)=ipari(37,ni)+4*igrsurf(isu1)%NSEG
605 isu2 =nom_opt(4,ninter+jsub)
606 ipari(38,ni)=ipari(38,ni)+igrsurf(isu2)%NSEG
607 ENDIF
608 END IF
609
610C Subinter : Case Inter 0
611
612 IF(nom_opt(2,ninter+jsub) == 0 .AND. nom_opt(5,ninter+jsub) == 1) THEN
613 nisub=nisub+1
614 isu1 =nom_opt(3,ninter+jsub)
615 isu2 =nom_opt(6,ninter+jsub)
616 IF(isu2 /= 0 ) THEN
617 ipari(37,ni) = ipari(37,ni) + 4* igrsurf(isu2)%NSEG
618 ipari(38,ni)=ipari(38,ni)+igrsurf(isu2)%NSEG
619 ENDIF
620 IF(isu1 /=0 ) THEN
621 ipari(37,ni) = ipari(37,ni) + 4* igrsurf(isu1)%NSEG
622 ipari(38,ni)=ipari(38,ni)+igrsurf(isu1)%NSEG
623 ENDIF
624 END IF
625
626 END DO
627 ipari(36,ni)=nisub
628C
629 ELSEIF (ntyp == 11) THEN
630C
631 DO jsub=1,nintsub
632 IF(nom_opt(2,ninter+jsub) == noint .AND. nom_opt(5,ninter+jsub) == 1)THEN
633 nisub=nisub+1
634 IF (ipari(71,ni) == 0) THEN
635 isu1 =nom_opt(4,ninter+jsub)
636 ipari(37,ni)=ipari(37,ni)+igrslin(isu1)%NSEG
637 isu2 =nom_opt(3,ninter+jsub)
638 ipari(38,ni)=ipari(38,ni)+igrslin(isu2)%NSEG
639 ELSE
640C-- Type11 of type19
641 isu1 =nom_opt(4,ninter+jsub)
642 ipari(37,ni)=ipari(37,ni)+4*igrsurf(isu1)%NSEG
643 isu2 =nom_opt(3,ninter+jsub)
644 ipari(38,ni)=ipari(38,ni)+4*igrsurf(isu2)%NSEG
645 ENDIF
646 END IF
647
648C Subinter : Case Inter 0
649
650 IF(nom_opt(2,ninter+jsub) == 0 .AND. nom_opt(5,ninter+jsub) == 1) THEN
651 nisub=nisub+1
652 isu1 =nom_opt(3,ninter+jsub)
653 isu2 =nom_opt(6,ninter+jsub)
654 IF(isu2 /= 0 ) THEN
655 ipari(37,ni) = ipari(37,ni) + 4* igrsurf(isu2)%NSEG
656 ipari(38,ni) = ipari(38,ni) + 4* igrsurf(isu2)%NSEG
657 ENDIF
658 IF(isu1 /=0 ) THEN
659 ipari(38,ni)=ipari(38,ni)+4*igrsurf(isu1)%NSEG
660 ipari(37,ni) = ipari(37,ni) + 4* igrsurf(isu1)%NSEG
661 ENDIF
662 END IF
663 END DO
664 ipari(36,ni)=nisub
665C
666 END IF
667C
668 IF(ntyp/=23)THEN
669 nrtms = max(nrtms,nrts_fe+nrts_ige)
670 nrtmm = max(nrtmm,nrtm_fe+nrtm_ige)
671 nrtms_ige = max(nrtms_ige,nrts_ige)
672 nrtmm_ige = max(nrtmm_ige,nrtm_ige)
673 ELSE
674 nrtms = max(nrtms,2*nrts)
675 nrtmm = max(nrtmm,2*nrtm)
676 END IF
677C
678 ENDDO
679C=======================================================================
680 s_irects = nrtms*4
681 s_irectm = nrtmm*4
682 ALLOCATE (irects(s_irects) ,stat=stat)
683 ALLOCATE (irectm(s_irectm) ,stat=stat)
684 s_nsv=max(numnod,nrtms_ige*16)
685 ALLOCATE (nsv(s_nsv) ,stat=stat)
686 s_msr=max(numnod,nrtmm_ige*16)
687 ALLOCATE (msr(s_msr) ,stat=stat)
688 IF (stat /= 0) CALL ancmsg(msgid=268, anmode=aninfo, msgtype=msgerror, c1='IRECTS')
689 irects = 0
690 irectm = 0
691 nsv(1:s_nsv) = 0
692 msr(1:s_msr) = 0
693 maxnsne = 0
694C
695C----
696C READING DATA - SURFACE SECONDARY/MAIN
697C----
698C=======================================================================
699 DO ni=1,linter
700
701 nrts = ipari(3,ni)
702 nrtm = ipari(4,ni)
703 nsn = ipari(5,ni)
704 nmn = ipari(6,ni)
705 ntyp = ipari(7,ni)
706 noint = ipari(15,ni)
707 is1 = ipari(13,ni)/10
708 igap = ipari(21,ni)
709 inacti = ipari(22,ni)
710 ilagm = ipari(33,ni)
711 is2 = mod(ipari(13,ni),10)
712 isu1 = ipari(45,ni)
713 isu2 = ipari(46,ni)
714 irs = 0
715 irm = 0
716 iedge = ipari(58,ni)
717 type18=.false.
718 IF(ntyp==7 .AND. inacti==7 )type18=.true.
719 grbric_id = isu1
720 IF(type18)grbric_id = ipari(83,ni)
721C-- deactivated interfaces
722 IF (ntyp == 0) cycle
723C-----Isogeometric elements
724 IF(ntyp==7) THEN
725 nrtm_ige = ipari(73,ni)
726 nrtm_fe = ipari(74,ni)
727 nrts_ige = ipari(75,ni)
728 nrts_fe = ipari(76,ni)
729 nsn_ige = ipari(77,ni)
730 nsn_fe = ipari(78,ni)
731 nmn_ige = ipari(79,ni)
732 nmn_fe = ipari(80,ni)
733 ELSE
734 nrtm_ige = 0
735 nrtm_fe = nrtm
736 nrts_ige = 0
737 nrts_fe = nrts
738 nsn_ige = 0
739 nsn_fe = nsn
740 nmn_ige = 0
741 nmn_fe = nmn
742 ENDIF
743C-------------------------------------------
744 id=nom_opt(1,ni)
745 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,ni),ltitr)
746C--------------------------------------------
747C 1) SECONDARY SIDE FROM NODES IN GRBRIC (INT18)
748C--------------------------------------------
749 IF (type18)THEN
750 !TYPE18 + GRNOD_ID
751 IF(grbric_id > 0)THEN
752 nbric = igrbric(grbric_id)%NENTITY
753 IF (multi_fvm%IS_USED)THEN
754 nsn_fe = nbric
755 ipari(14,ni) = 151
756 ELSE
757 ipari(14,ni) = 0
758 nbric=igrbric(isu1)%NENTITY
759 CALL ingrbric_nodes(nsn_fe ,igrbric(grbric_id)%ENTITY ,itab ,nsv ,
760 . ixs , nbric, nale ,ipm, bufmat,s_nsv)
761 ENDIF
762 ELSE
763 nbric = 0
764 nsn = 0
765 ENDIF
766 nsn = nsn_fe+nsn_ige
767 ipari(5,ni) = nsn
768 ipari(78,ni) = nsn_fe
769
770 IF(grbric_id > 0)THEN
771 is_gap_computed = .false.
772 CALL ingrbric_dx(nbric , igrbric(grbric_id)%ENTITY, frigap(2,ni) , ixs , x ,
773 . noint , titr , is_gap_computed, pm , ipm ,
774 . iddlevel, istiff , auto_rho , auto_length,
775 . multi_fvm)
776 IF(is_gap_computed)THEN
777 WRITE(iout,1000)noint
778 WRITE(iout,3020)frigap(2,ni)
779 ENDIF
780 ENDIF
781C--------------------------------------------
782C 2) SECONDARY FROM SURFACE
783C--------------------------------------------
784 ELSEIF ( ntyp/=15.and.ntyp/=17.and.ntyp/=20.and.ntyp/=22.and.
785 . ntyp/=23.and.ntyp/=24.and.ntyp/=25) THEN
786C--------------------------------------------
787 IF(is1 /= 0) THEN
788 IF(nrts_fe == 0.AND.nrts_ige == 0.AND.is1 /= 2.AND.is1 /= 5 .AND. is1 /=-1) THEN
789 CALL ancmsg(msgid=118, msgtype=msgerror, anmode=aninfo, i1=id, c1=titr)
790 ENDIF
791 IF(is1 == 1)THEN
792 IF (ntyp == 3 .OR. ntyp == 6) irs = ipari(25,ni)
793 surf_nodes => igrsurf(isu1)%NODES(1:nrts_fe,1:4)
794 CALL insurf(nrts_fe,nsn_fe,irs,irects,
795 . surf_nodes,itab,nsv,id,titr,
796 . ntag,s_nsv,s_irects,type18)
797 IF (igrsurf(isu1)%NSEG_IGE >= 1) THEN
798 surf_nodes_ige => igrsurf(isu1)%NODES_IGE(1:nrts_ige,1:4)
799 iad_ige = igrsurf(isu1)%IAD_IGE
800 CALL insurfigeo(nrts_ige,nrts_fe,nsn_ige,0,iad_ige,irm,irects,noint,
801 . surf_nodes_ige,itab,nsv,id,titr,
802 . ibid,rbid,rbid,rbid,ibid,rbid,rbid,rbid)
803 ENDIF
804 ELSEIF(is1 == 2)THEN
805 CALL inpoint(nsn_fe,noint,igrnod(isu1)%ENTITY,itab,nsv)
806 ELSEIF(is1 == 3)THEN
807 line_nodes => igrslin(isu1)%NODES(1:nrts,1:2)
808 CALL inslin(nrts,nsn_fe,irects,noint,
809 . line_nodes,itab,nsv,
810 . ntag)
811
812 ELSEIF(is1==5) THEN
813 nbric = igrbric(isu1)%NENTITY
814 CALL ingrbric(nsn, igrbric(isu1)%ENTITY, nsv,
815 . ixs, nbric, pm,s_nsv, igeo)
816 ENDIF
817 ENDIF
818 nsn = nsn_fe+nsn_ige
819 ipari(5,ni) = nsn
820 ipari(77,ni) = nsn_ige
821 ipari(78,ni) = nsn_fe
822C--------------------------------------------
823C 2) SECONDARY GRBRIC (INT22)
824C--------------------------------------------
825 ELSEIF(ntyp==22) THEN
826 IF(isu1 > 0)THEN
827 nbric=igrbric(isu1)%NENTITY
828 CALL ingrbric(nsn , igrbric(isu1)%ENTITY ,nsv ,
829 . ixs , nbric ,pm, s_nsv, igeo)
830 ELSE
831 nbric = 0
832 nsn = 0
833 ENDIF
834 ipari(5,ni) = nsn
835 ipari(32,ni) = nbric !IBAG type7
836 ipari(30,ni) = isu1 !IBAG type7
837C--------------------------------------------
838 ELSEIF(ntyp==23) THEN
839 IF(is1 /= 0) THEN
840 IF(nrts == 0.AND.is1 /= 2) THEN
841 CALL ancmsg(msgid=118, msgtype=msgerror, anmode=aninfo, i1=id, c1=titr)
842 ENDIF
843 IF(is1 == 1)THEN
844 surf_nodes => igrsurf(isu1)%NODES(1:nrts,1:4)
845 CALL insurf23(nrts,nsn,irs,irects,noint,
846 . surf_nodes,itab,nsv,nrts_new,x,
847 . ntag)
848 ENDIF
849 nrts = nrts_new
850 ipari(3,ni) = nrts
851 ENDIF
852 ipari(5,ni) = nsn
853C--------------------------------------------
854 ENDIF
855C-----
856C 2)SURFACE MAIN :
857C-----
858C--------------------------------------------
859 IF (ntyp == 14) THEN
860C--------------------------------------------
861 IF(nrtm == 0) THEN
862 CALL ancmsg(msgid=119, msgtype=msgerror, anmode=aninfo, i1=id, c1=titr)
863 ENDIF
864 ipari(19,ni)=1
865C--------------------------------------------
866 ELSEIF ( ntyp == 15) THEN
867C--------------------------------------------
868C SURFACE SECONDARY
869 IF(nrts == 0) THEN
870 CALL ancmsg(msgid=118, msgtype=msgerror, anmode=aninfo, i1=id, c1=titr)
871 ENDIF
872 surf_nodes => igrsurf(isu1)%NODES(1:nrts,1:4)
873 CALL insurf(nrts,nsn,irs,irects,
874 . surf_nodes,itab,nsv,id,titr,
875 . ntag,s_nsv,s_irects,type18)
876 ipari(5,ni) = nsn
877C SURFACE MAIN :
878 IF(nrtm == 0) THEN
879 CALL ancmsg(msgid=119, msgtype=msgerror, anmode=aninfo, i1=id, c1=titr)
880 ENDIF
881 ipari(19,ni)=1
882C--------------------------------------------
883 ELSEIF ( ntyp == 20) THEN
884C--------------------------------------------
885C--------------------------------------------
886 ELSEIF ( ntyp == 22) THEN
887C--------------------------------------------
888 surf_nodes => igrsurf(isu2)%NODES(1:nrtm,1:4)
889 CALL insurf(nrtm,nmn,irm,irectm,
890 . surf_nodes,itab,msr,id,titr,
891 . ntag,s_msr,s_irectm,type18)
892 ipari(6,ni) = nmn !number of main node.
893 ipari(33,ni) = igrsurf(isu2)%NSEG ! number of main facet
894 ipari(4,ni) = igrsurf(isu2)%NSEG
895C--------------------------------------------
896 ELSEIF( ntyp == 23) THEN
897 IF(is2 /= 0) THEN
898 IF(nrtm == 0) THEN
899 CALL ancmsg(msgid=119, msgtype=msgerror, anmode=aninfo, i1=id, c1=titr)
900 ENDIF
901 IF(is2 == 1)THEN
902 surf_nodes => igrsurf(isu2)%NODES(1:nrtm,1:4)
903 CALL insurf23(nrtm,nmn,irm,irectm,noint,
904 . surf_nodes,itab,msr,nrtm_new,x,
905 . ntag)
906 ENDIF
907 nrtm = nrtm_new
908 ipari(4,ni)=nrtm
909 ipari(6,ni)=nmn
910 ENDIF
911 ELSEIF ( ntyp == 24) THEN
912C--------------------------------------------
913C--------------------------------------------
914 ELSEIF ( ntyp == 25) THEN
915C--------------------------------------------
916C--------------------------------------------
917 ELSE
918 IF (ntyp == 3 .OR. ntyp == 5 .OR.
919 . ntyp == 6 .OR. ntyp == 8) irm = ipari(24,ni)
920 IF(is2 /= 0) THEN
921 IF(nrtm_fe == 0 .AND. nrtm_ige == 0) THEN
922 CALL ancmsg(msgid=119, msgtype=msgerror, anmode=aninfo, i1=id, c1=titr)
923 ENDIF
924 IF(ntyp == 2 .AND. is2 == -1)THEN
925 nmn_fe = ipari(6,ni)
926 ELSEIF(is2 == 1)THEN
927 surf_nodes => igrsurf(isu2)%NODES(1:nrtm_fe,1:4)
928 CALL insurf(nrtm_fe,nmn_fe,irm,irectm,
929 . surf_nodes,itab,msr,id,titr,
930 . ntag,s_msr,s_irectm,type18)
931 IF (ntyp == 1)THEN
932 CALL inter1_check_ale_lag_sides(n2d, igrsurf(isu1)%ID, igrsurf(isu2)%ID, id, titr,
933 . numnod, itab, nrts_fe, nrtm_fe, irects, irectm,nale, iddlevel)
934 igrsurf(isu1)%NSEG = nrts_fe
935 igrsurf(isu2)%NSEG = nrtm_fe
936 ipari(74,ni) = nrtm_fe
937 ipari(76,ni) = nrts_fe
938 ENDIF
939 IF (igrsurf(isu2)%NSEG_IGE >= 1) THEN
940 surf_nodes_ige => igrsurf(isu2)%NODES_IGE(1:nrtm_ige,1:4)
941 iad_ige = igrsurf(isu2)%IAD_IGE
942 CALL insurfigeo(nrtm_ige,nrtm_fe,nmn_ige,nsn_ige,iad_ige,irm,irectm,noint,
943 . surf_nodes_ige,itab,msr,id,titr,
944 . ibid,rbid,rbid,rbid,ibid,rbid,rbid,rbid)
945 ENDIF
946 ELSEIF(is2 == 3)THEN
947 line_nodes => igrslin(isu2)%NODES(1:nrtm,1:2)
948 CALL inslin(nrtm,nmn_fe,irectm,noint,
949 . line_nodes,itab,msr,
950 . ntag)
951 ELSEIF(is2 == 4) THEN
952 surf_nodes => igrsurf(isu2)%NODES(1:nrtm_fe,1:4)
953 CALL insurf(nrtm_fe,nmn_fe,irm,irectm,
954 . surf_nodes,itab,msr,id,titr,
955 . ntag,s_msr,s_irectm,type18)
956 IF (igrsurf(isu2)%NSEG_IGE >= 1) THEN
957 surf_nodes_ige => igrsurf(isu2)%NODES_IGE(1:nrtm_ige,1:4)
958 iad_ige = igrsurf(isu2)%IAD_IGE
959 CALL insurfigeo(nrtm_ige,nrtm_fe,nmn_ige,0,iad_ige,irm,irectm,noint,
960 . surf_nodes_ige,itab,msr,id,titr,
961 . ibid,rbid,rbid,rbid,ibid,rbid,rbid,rbid)
962 ENDIF
963 ENDIF
964 nmn = nmn_fe+nmn_ige
965 ipari(6,ni) = nmn
966 ipari(79,ni) = nmn_ige
967 ipari(80,ni) = nmn_fe
968 ENDIF
969C--------------------------------------------
970 IF ( type18 ) THEN
971 IF(istiff == 2 .AND. isu2 > 0)THEN
972 stiff_stat(1) = -stfac(ni) !-STFAC*VREF*VREF
973 stiff_stat(2) = auto_rho ! (RHO0_MAX : also computed for multimaterials)
974 stiff_stat(3) = frigap(2,ni) !gap
975 surf_nodes => igrsurf(isu2)%NODES(1:nrtm,1:4)
976 CALL insurf_dx(nrtm,nmn,irm,irectm,noint,
977 . surf_nodes,itab,msr,id,titr,
978 . ntag,s_msr,s_irectm,x, stiff_stat)
979 stfac(ni)=stiff_stat(1)
980 ENDIF
981 ENDIF
982 ENDIF
983C--------------------------------------------
984C
985C-------
986 IF (ntyp == 1) THEN
987C-------
988 CALL presegmt(irectm,msr,nrtm,nmn,ipari(9,ni))
989 nmnt=max0(nmnt,6*nmn)
990C-------
991 ELSEIF (ntyp == 2) THEN
992C-------
993 ilev = ipari(20,ni)
994 IF (ilev == 10 .OR. ilev == 11 .OR. ilev == 12) THEN
995 pid = nintri(ipari(43,ni),igeo,npropgi,numgeo,1)
996 IF (pid > 0) THEN
997 nuvar = igeo(27,pid)
998 ipari(35,ni) = nuvar
999 ipari(43,ni) = pid
1000 ELSE
1001c print*,'error interface user'
1002 ENDIF
1003C
1004 ELSEIF (ilev == 27 . or . ilev == 28) THEN
1005C-------- Dimension of arrays for TYPE2 incompatible spt27 or 28
1006 IF (is1==-1) THEN
1007 nsn_multi_connec = nsn_multi_connec + nsn
1008 ELSE
1009 DO i=1,igrnod(isu1)%NENTITY
1010 isl = igrnod(isu1)%ENTITY(i)
1011 t2_nb_connec(isl) = t2_nb_connec(isl) + 1
1012 IF (t2_nb_connec(isl) == 2) nsn_multi_connec = nsn_multi_connec + 1
1013 ENDDO
1014 END IF
1015 ENDIF
1016C
1017 IF (ilagm == 1)THEN
1018 ncf_i2 = nsn*6
1019 lag_nhf = lag_nhf + ncf_i2*(ncf_i2-1)/2
1020 lag_ncf = lag_ncf + ncf_i2
1021 lag_nkf = lag_nkf + ncf_i2*13
1022 ENDIF
1023 maxrtm_t2=max(maxrtm_t2,nrtm)
1024C-------
1025 ELSEIF (ntyp == 3 ) THEN
1026C-------
1027 CALL presegmt(irects,nsv,nrts,nsn,ipari(8,ni))
1028 CALL presegmt(irectm,msr,nrtm,nmn,ipari(9,ni))
1029
1030 imaximp = imaximp + 2*nint(nmn/probint)
1031C-------
1032 ELSEIF (ntyp == 4) THEN
1033C-------
1034 CALL presegmt(irects,nsv,nrts,nsn,ipari(8,ni))
1035 CALL presegmt(irectm,msr,nrtm,nmn,ipari(9,ni))
1036
1037 ibuc =ipari(12,ni)
1038 IF(ibuc /= 0)nmnt =max0(nmnt,14*nsn)
1039 imaximp = imaximp + 2*nint(nmn/probint)
1040C-------
1041 ELSEIF (ntyp == 5) THEN
1042C-------
1043 CALL presegmt(irects,nsv,nrts,nsn,ipari(8,ni))
1044 CALL presegmt(irectm,msr,nrtm,nmn,ipari(9,ni))
1045 imaximp = imaximp + 2*(nint(nmn/probint) + nint(nsn/probint))
1046C-------
1047 ELSEIF (ntyp == 6) THEN
1048C-------
1049 CALL presegmt(irects,nsv,nrts,nsn,ipari(8,ni))
1050 CALL presegmt(irectm,msr,nrtm,nmn,ipari(9,ni))
1051 imaximp = imaximp + 2*nint(nsn/probint)
1052C-------
1053 ELSEIF (ntyp == 7) THEN
1054C-------
1055 ipari(18,ni) = nsn_fe+nsn_ige+nmn_fe+nmn_ige
1056 ipari(24,ni) = nsn_fe+nsn_ige
1057 ipari(25,ni) = nsn_fe+nsn_ige+nmn_fe+nmn_ige
1058 imaximp = imaximp + multimp*(nsn_fe+nsn_ige)
1059 nmnt =max0(nmnt,nsn_ige + 3)
1060
1061 IF (ilagm > 0) THEN
1062 lag_nc16 = numnod
1063 lag_nk16 = numnod*15
1064 nmnt = max(nmnt, 4*(nmn+100)+ 2*(nsn_fe+nsn_ige) + lag_nc16 + 4*lag_nk16)
1065 ENDIF
1066
1067 maxrtm=max(maxrtm,nrtm)
1068C-------
1069 ELSEIF (ntyp == 8) THEN
1070C-------
1071 CALL presegmt(irectm,msr,nrtm,nmn,ipari(9,ni))
1072 ipari(8,ni) = 0
1073 imaximp = imaximp + 2*nint(nsn/probint)
1074C-------
1075 ELSEIF (ntyp == 9) THEN
1076C-------
1077 CALL presegmt(irects,nsv,nrts,nsn,ipari(8,ni))
1078 CALL presegmt(irectm,msr,nrtm,nmn,ipari(9,ni))
1079
1080 nmnt=max0(nmnt,8*nmn)
1081 imaximp = imaximp + 2*nint(nmn/probint)
1082C-------
1083 ELSEIF (ntyp == 10) THEN
1084C-------
1085 ipari(18,ni) = nsn+nmn
1086 ipari(24,ni) = nsn
1087 ipari(25,ni) = nsn+nmn
1088 nmnt =max0(nmnt,nsn + 3)
1089 imaximp = imaximp + multimp*nsn
1090 maxrtm=max(maxrtm,nrtm)
1091C-------
1092 ELSEIF (ntyp == 11) THEN
1093C-------
1094 ipari(18,ni) = nsn+nmn
1095 ipari(24,ni) = nsn
1096 ipari(25,ni) = nsn+nmn
1097 maxrtms=max(maxrtms,nrtm)
1098 maxrtms=max(maxrtms,nrts)
1099 imaximp = imaximp + multimp*nsn
1100C-------
1101 ELSEIF (ntyp == 12) THEN
1102C-------
1103 CALL presegmt(irects,nsv,nrts,nsn,ipari(8,ni))
1104 CALL presegmt(irectm,msr,nrtm,nmn,ipari(9,ni))
1105 nmnt=max0(nmnt,2*ale%GLOBAL%NVCONV*nsn+nrtm+nmn*(ale%GLOBAL%NVCONV+1),3*(nsn+nmn))
1106 IF(ipari(20,ni) == 1) nmnt=max0(nmnt,6*nmn)
1107C-------
1108 ELSEIF (ntyp == 14) THEN
1109C-------
1110 imaximp = imaximp + 2*nint(nsn/probint/5)
1111C-------
1112 ELSEIF (ntyp == 15) THEN
1113C-------
1114 imaximp = imaximp + 2*nint(nrts*4/probint/5)
1115C-------
1116 ELSEIF (ntyp == 18) THEN
1117C-------
1118 ipari(36,ni)=0
1119 ipari(18,ni) = nsn+nmn
1120 ipari(24,ni) = nsn
1121 ipari(25,ni) = nsn+nmn
1122 imaximp = imaximp + multimp*nsn
1123 !NMNT =MAX0(NMNT,NSN + 3)
1124 maxrtm=max(maxrtm,nrtm)
1125C-------
1126 ELSEIF (ntyp == 20) THEN
1127C-------
1128 ipari(18,ni) = nsn+nmn
1129 ipari(24,ni) = nsn
1130 ipari(25,ni) = nsn+nmn
1131 imaximp = imaximp + multimp*nsn
1132 nmnt =max0(nmnt,nsn + 3)
1133 maxrtm=max(maxrtm,nrtm)
1134C allocate dimensions i11buc1
1135 nlinsa = ipari(53,ni)
1136 nlinma = ipari(54,ni)
1137 nsne = ipari(55,ni)
1138 nmnt =max0(nmnt,nsne + 3)
1139 maxrtm=max(maxrtm,nlinma)
1140 maxrtms=max(maxrtms,nlinma)
1141 maxrtms=max(maxrtms,nlinsa)
1142C-------
1143 ELSEIF (ntyp == 21) THEN
1144C-------
1145 ipari(8,ni) = nmn
1146 ipari(36,ni) = 0
1147 ipari(18,ni) = nsn+nmn
1148 ipari(24,ni) = nsn
1149 ipari(25,ni) = nsn+nmn
1150 imaximp = imaximp + multimp*nsn
1151 nmnt =max0(nmnt,nsn + 3)
1152 maxrtm=max(maxrtm,nrtm)
1153C-------
1154 ELSEIF (ntyp == 22) THEN
1155C-------
1156 ipari(18,ni) = nsn+nmn
1157 ipari(24,ni) = nsn
1158 ipari(25,ni) = nsn+nmn
1159 imaximp = imaximp + multimp*nsn
1160 nmnt =max0(nmnt,nsn + 3)
1161 IF (ilagm > 0) THEN
1162 lag_nc16 = numnod
1163 lag_nk16 = numnod*15
1164 nmnt = max(nmnt, 4*(nmn+100)+ 2*nsn + lag_nc16 + 4*lag_nk16)
1165 ENDIF
1166 maxrtm=max(maxrtm,nrtm)
1167C-------
1168 ELSEIF (ntyp == 23) THEN
1169C-------
1170 ipari(18,ni) = nsn+nmn
1171 ipari(24,ni) = nsn
1172 ipari(25,ni) = nsn+nmn
1173 nmnt =max0(nmnt,nsn + 3)
1174 imaximp = imaximp + multimp*nsn
1175 maxrtm=max(maxrtm,nrtm)
1176C-------
1177 ELSEIF (ntyp == 24) THEN
1178C-------
1179 nrtm = nrtm+ipari(42,ni)
1180 ipari(4,ni) = nrtm
1181 ipari(18,ni) = nsn+nmn
1182 ipari(24,ni) = nsn
1183 ipari(25,ni) = nsn+nmn
1184 imaximp = imaximp + multimp*nsn
1185 nmnt =max0(nmnt,nsn + 3)
1186 IF (ilagm > 0) THEN
1187 lag_nc16 = numnod
1188 lag_nk16 = numnod*15
1189 nmnt = max(nmnt, 4*(nmn+100)+ 2*nsn + lag_nc16 + 4*lag_nk16)
1190 ENDIF
1191 maxrtm=max(maxrtm,nrtm)
1192 maxnsne=max(maxnsne,ipari(55,ni))
1193C-------
1194 ELSEIF (ntyp == 25) THEN
1195C-------
1196 nrtm = nrtm+ipari(42,ni)
1197 ipari(4,ni) = nrtm
1198 ipari(18,ni) = nsn+nmn
1199 ipari(24,ni) = nsn
1200 ipari(25,ni) = nsn+nmn
1201C
1202C NADMSR, NEDGE are over estimated for ALLOCATE
1203C NADMSR, NEDGE will be over written before writing
1204 ipari(67,ni)=4*nrtm
1205 ipari(68,ni)=4*nrtm
1206C
1207 IF(iedge /= 0) THEN
1208 nconte=4*nrtm ! cf NCONTE=NEDGE
1209 ipari(88,ni)=nconte
1210 ELSE
1211 nconte=0
1212 END IF
1213C
1214 imaximp = imaximp + multimp*nsn + multimpe*nconte + multimps*nconte
1215 !NMNT =MAX0(NMNT,NSN + 3)
1216 IF (ilagm > 0) THEN
1217 lag_nc16 = numnod
1218 lag_nk16 = numnod*15
1219 nmnt = max(nmnt, 4*(nmn+100)+ 2*nsn + lag_nc16 + 4*lag_nk16)
1220 ENDIF
1221 maxrtm=max(maxrtm,nrtm)
1222 maxnsne=max(maxnsne,ipari(55,ni))
1223 ENDIF
1224C
1225C-------
1226 ENDDO
1227C-----
1228 DO ni=1,linter
1229 ipari(19,ni)=0
1230 ENDDO
1231C-----
1232 lag_ncl = lag_ncl + lag_nc16
1233 lag_nkl = lag_nkl + lag_nk16
1234C
1235C=======================================================================
1236C-
1237 DEALLOCATE (irects)
1238 DEALLOCATE (irectm)
1239 DEALLOCATE (nsv)
1240 DEALLOCATE (msr)
1241
1242 NULLIFY(ntag)
1243 DEALLOCATE(ntag_target)
1244
1245! inter18 : automatic gap if not defined in input file
12461000 FORMAT(/1x,' INTERFACE NUMBER :',i10,1x,a)
12473020 FORMAT(' COMPUTED GAP VALUE. . . . . . . . . . . . . ',1pg20.13)
1248C-----
1249 RETURN
1250C-----
1251 END
my_real
#define my_real
Definition cppsort.cpp:32
i20surfi
subroutine i20surfi(iallo, ipari, igrnod, igrsurf, igrslin, irect, frigap, nsv, msr, ixlins, ixlinm, nsve, msre, itab, islins, islinm, nlg, x, nbinflg, mbinflg)
Definition i20surfi.F:41
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
i25surfi
subroutine i25surfi(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, parameters, nin25, flag_elem_inter25)
Definition i25surfi.F:47
ingrbric
subroutine ingrbric(msn, brics, msv, ixs, nbric, pm, s_msv, igeo)
Definition ingrbric.F:32
ingrbric_dx
subroutine ingrbric_dx(nbric, ibufssg, global_gap, ixs, x, noint, titr, is_gap_computed, pm, ipm, iddlevel, istiff, auto_rho, auto_length, multi_fvm)
Definition ingrbric_dx.F:36
ingrbric_nodes
subroutine ingrbric_nodes(msn, ibufssg, itab, msv, ixs, nbric, nale, ipm, bufmat, s_msv)
Definition ingrbric_nodes.F:36
inpoint
subroutine inpoint(msn, noint, brics, itab, msv)
Definition inpoint.F:32
inslin
subroutine inslin(nrt, msn, irect, noint, slin_nodes, itab, msv, ntag)
Definition inslin.F:34
insurf23
subroutine insurf23(nrt, msn, ir, irect, noint, surf_nodes, itab, msv, nrtnew, x, ntag)
Definition insurf23.F:36
insurf
subroutine insurf(nrt, msn, ir, irect, surf_nodes, itab, msv, id, titr, ntag, s_msv, sirect, type18)
Definition insurf.F:38
insurf_dx
subroutine insurf_dx(nrt, msn, ir, irect, noint, surf_nodes, itab, msv, id, titr, ntag, s_msv, sirect, x, stiff_stat)
Definition insurf_dx.F:34
insurfigeo
subroutine insurfigeo(nrt_ige, offset_seg, msn_ige, offset_node, iadtabige, ir, irect, noint, surf_nodes_ige, itab, msv, id, titr, nige, rige, xige, vige, nige_tmp, rige_tmp, xige_tmp, vige_tmp)
Definition insurfigeo.F:37
i2rupt
subroutine i2rupt(x, v, a, ms, in, stifn, fsav, weight, irect, nsv, msr, irtl, irupt, crst, mmass, miner, smass, siner, area, uvar, xsm0, dsm, fsm, prop, ipari, nsn, nmn, nuvar, igtyp, pid, npf, tf, itab, fncont, pdama2, isym, inorm, h3d_data, fncontp, ftcontp)
Definition int2rupt.F:122
lecint
subroutine lecint(ipari, linter, ipm, bufmat, nmnt, itab, itabm1, geo, pm, x, igrnod, igrsurf, igrslin, npc, probint, lag_ncf, lag_nkf, lag_ncl, lag_nkl, lag_nhf, maxrtm, iskn, maxrtms, igeo, xfiltr, stfac, fric_p, frigap, i2rupt, areasl, unitab, ixs, nom_opt, itag, ixc, ixtg, knod2elc, knod2eltg, nod2elc, nod2eltg, knod2els, nod2els, ixs10, ixs16, ixs20, def_inter, maxnsne, npc1, multi_fvm, nom_optfric, intbuf_fric_tab, igrbric, igrsh3n, igrtruss, maxrtm_t2, nsn_multi_connec, t2_nb_connec, iddlevel, nale, interfaces, snpc1, flag_elem_inter25, list_nin25)
Definition lecint.F:66
max
#define max(a, b)
Definition macros.h:21
ale_mod
Definition ale_mod.F:150
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:253
groupdef_mod
Definition groupdef_mod.F:668
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
r2r_mod
Definition r2r_mod.F:125
unitab_mod
Definition unitab_mod.F:517
presegmt
subroutine presegmt(irect, nodes, nrt, nno, nst)
Definition presegmt.F:32
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799
starter
program starter
Definition starter.F:39