OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lecint.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "scr17_c.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ lecint()

subroutine lecint ( integer, dimension(npari,ninter) ipari,
integer linter,
integer, dimension(npropmi,nummat), intent(in) ipm,
dimension(sbufmat), intent(in) bufmat,
integer nmnt,
integer, dimension(sitab) itab,
integer, dimension(sitabm1) itabm1,
geo,
pm,
x,
type (group_), dimension(ngrnod) igrnod,
type (surf_), dimension(nsurf), target igrsurf,
type (surf_), dimension(nslin), target igrslin,
integer, dimension(snpc) npc,
probint,
integer lag_ncf,
integer lag_nkf,
integer lag_ncl,
integer lag_nkl,
integer lag_nhf,
integer maxrtm,
integer, dimension(siskwn) iskn,
integer maxrtms,
integer, dimension(npropgi,numgeo) igeo,
xfiltr,
stfac,
fric_p,
frigap,
i2rupt,
areasl,
type (unit_type_), intent(in) unitab,
integer, dimension(nixs,numels) ixs,
integer, dimension(lnopt1,*) nom_opt,
integer, dimension(*) itag,
integer, dimension(*) ixc,
integer, dimension(*) ixtg,
integer, dimension(*) knod2elc,
integer, dimension(*) knod2eltg,
integer, dimension(*) nod2elc,
integer, dimension(*) nod2eltg,
integer, dimension(*) knod2els,
integer, dimension(*) nod2els,
integer, dimension(6,*) ixs10,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
integer, dimension(100) def_inter,
integer maxnsne,
integer, dimension(snpc1) npc1,
type(multi_fvm_struct), intent(in) multi_fvm,
integer, dimension(lnopt1,*) nom_optfric,
type(intbuf_fric_struct_), dimension(*) intbuf_fric_tab,
type (group_), dimension(ngrbric) igrbric,
type (group_), dimension(ngrsh3n) igrsh3n,
type (group_), dimension(ngrtrus) igrtruss,
integer maxrtm_t2,
integer nsn_multi_connec,
integer, dimension(*) t2_nb_connec,
integer, intent(in) iddlevel,
integer, dimension(numnod), intent(in) nale,
type (interfaces_), intent(inout) interfaces,
integer, intent(in) snpc1,
integer, dimension(ninter25,numels), intent(inout) flag_elem_inter25,
integer, dimension(ninter), intent(inout) list_nin25 )
Parameters
[in]snpc1array size NPC1

Definition at line 51 of file lecint.F.

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