OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i24inisu_nei.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!|| i24inisur_nei ../starter/source/interfaces/inter3d1/i24inisu_nei.F
25!||--- called by ------------------------------------------------------
26!|| inint3 ../starter/source/interfaces/inter3d1/inint3.F
27!||--- calls -----------------------------------------------------
28!|| comm_seg_en ../starter/source/interfaces/inter3d1/i24inisu_nei.F
29!|| msg_err ../starter/source/interfaces/inter3d1/i24tools.F
30!||--- uses -----------------------------------------------------
31!||====================================================================
32 SUBROUTINE i24inisur_nei(NRTM ,NSN,IRECT,IRTLM,MVOISIN,
33 2 NVOISIN,MSEGLO ,MSEGTYP,ITAB ,X ,
34 3 ID,TITR,IGEO )
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE names_and_titles_mod , ONLY : nchartitle
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "com04_c.inc"
47#include "param_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER NRTM,NSN,IRECT(4,NRTM),MVOISIN(4,NRTM),NVOISIN(8,NRTM),
52 . MSEGLO(NRTM),IRTLM(2,NSN),MSEGTYP(NRTM),ITAB(*),
53 . igeo(npropgi,*)
54 INTEGER ID
55 CHARACTER(LEN=NCHARTITLE) :: TITR
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER I,J,K,IW,I1,I2,I3,M,NMAX,N_MAX,E_MAX,E_ID,N_EI,
60 1 ITAG(NUMNOD),N_NI,NE0,NN0,NRTM_SH,NRTM0,
61 2 j1,j2,j3,j4,k1,k2,l1,l2,kperm1(4),kperm2(4),irr,
62 3 nft,jlt
63 INTEGER, DIMENSION(:),ALLOCATABLE :: MVOI,NVOI
64 INTEGER, DIMENSION(:,:),ALLOCATABLE :: EIDNOD
65 my_real
66 . x(*)
67 DATA kperm1/1,3,5,7/
68 DATA kperm2/2,4,6,8/
69C init IRTLM (done before) MSEGLO
70C IRTLM(1:2,1:NSN)=0
71 DO i=1,nrtm
72 mseglo(i)=i
73 ENDDO
74C-----------shell segs have been duplicated w/ inverse order
75C-----------for the moment all antisymmetry surface will be stored at the end
76 DO i=1,numnod
77 itag(i)=0
78 ENDDO
79 DO i=1,nrtm
80 DO j=1,3
81 m=irect(j,i)
82 itag(m)=itag(m)+1
83 END DO
84 IF (irect(4,i)/=irect(3,i))THEN
85 m= irect(4,i)
86 itag(m)=itag(m)+1
87 END IF
88 END DO
89C-----MSEGTYP (<0 for i=NRTM0+1,NRTM0+NRTM_SH) -> IM2SH---------
90C-----------max number of connected segment per node
91 nmax=0
92 DO i=1,numnod
93 nmax=max(nmax,itag(i))
94 itag(i)=0
95 ENDDO
96 ALLOCATE(mvoi(nmax+10),nvoi(2*nmax+10),eidnod(nmax,numnod))
97 eidnod=0
98C------------ini- E_ids of each node
99 DO i=1,nrtm
100 DO j=1,3
101 m=irect(j,i)
102 itag(m)=itag(m)+1
103 eidnod(itag(m),m)=i
104 END DO
105 IF (irect(4,i)/=irect(3,i)) THEN
106 m= irect(4,i)
107 itag(m)=itag(m)+1
108 eidnod(itag(m),m)=i
109 END IF
110 END DO
111C------------MVOISIN-(seg number)-,NVOISIN (node number)---
112 e_max=4
113 n_max=8
114 DO i=1,nrtm
115 DO j=1,n_max
116 nvoisin(j,i)=0
117 END DO
118 DO j=1,e_max
119 mvoisin(j,i)=0
120 END DO
121 END DO
122C
123 DO i=1,nrtm
124 n_ei=0
125 n_ni=0
126C----seg 1-2------
127 i1 =irect(1,i)
128 i2 =irect(2,i)
129 CALL comm_seg_en(itag(i1),eidnod(1,i1),itag(i2),eidnod(1,i2),
130 1 n_ei,mvoi ,i ,i1 ,i2 ,irect,msegtyp ,
131 2 n_ni,nvoi ,x ,mvoisin(1,i),nvoisin(1,i),
132 3 irr )
133 IF (irr >0) CALL msg_err(i1,i2,itab,irr,id,titr)
134C----seg 2-3------
135 i1 =irect(2,i)
136 i2 =irect(3,i)
137 CALL comm_seg_en(itag(i1),eidnod(1,i1),itag(i2),eidnod(1,i2),
138 1 n_ei,mvoi ,i ,i1 ,i2 ,irect,msegtyp ,
139 2 n_ni,nvoi ,x ,mvoisin(1,i),nvoisin(1,i),
140 3 irr )
141 IF (irr >0) CALL msg_err(i1,i2,itab,irr,id,titr)
142C----seg 3-4------
143 i1 =irect(3,i)
144 i2 =irect(4,i)
145 CALL comm_seg_en(itag(i1),eidnod(1,i1),itag(i2),eidnod(1,i2),
146 1 n_ei,mvoi ,i ,i1 ,i2 ,irect,msegtyp ,
147 2 n_ni,nvoi ,x ,mvoisin(1,i),nvoisin(1,i),
148 3 irr )
149 IF (irr >0) CALL msg_err(i1,i2,itab,irr,id,titr)
150C----seg 1-4------
151 i1 =irect(4,i)
152 i2 =irect(1,i)
153 CALL comm_seg_en(itag(i1),eidnod(1,i1),itag(i2),eidnod(1,i2),
154 1 n_ei,mvoi ,i ,i1 ,i2 ,irect,msegtyp ,
155 2 n_ni,nvoi ,x ,mvoisin(1,i),nvoisin(1,i),
156 3 irr )
157 IF (irr >0) CALL msg_err(i1,i2,itab,irr,id,titr)
158
159c sous-triangles
160c goto 6543
161 DO k1=1,4
162 k2=k1+1
163 IF(k2==5)k2=1
164 i1 = irect(k1,i)
165 i2 = irect(k2,i)
166 j = mvoisin(k1,i)
167 IF (j==0) cycle
168 j1 = irect(1,j)
169 j2 = irect(2,j)
170 j3 = irect(3,j)
171 j4 = irect(4,j)
172 l1 = kperm1(k1)
173 l2 = kperm2(k1)
174C-------------tria do nothing : +,+ -> 1
175 IF (j3==j4) THEN
176C
177 ELSEIF(j2==i2.and.j3==i1)THEN
178c sous-triangle 2
179 nvoisin(l1,i)=-nvoisin(l1,i)
180 ELSEIF(j3==i2.and.j4==i1)THEN
181c sous-triangle 3
182 nvoisin(l2,i)=-nvoisin(l2,i)
183 ELSEIF(j4==i2.and.j1==i1)THEN
184c sous-triangle 4
185 nvoisin(l1,i)=-nvoisin(l1,i)
186 nvoisin(l2,i)=-nvoisin(l2,i)
187c ELSE sous-triangle 1
188 ENDIF
189 ENDDO
190C
191 END DO !I=1,NRTM
192C
193 DEALLOCATE(mvoi,nvoi,eidnod)
194C
195c DO I=1,NRTM
196c print *,'N_E(I),MSEGTYP(I),I=',N_E(I),MSEGTYP(I),I
197c print *,'MVOISIN(1,I)=',(MVOISIN(J,I),J=1,N_E(I))
198c END DO
199c DO I=1,NRTM
200c print *,'IRECT(j,I)=',(ITAB(IRECT(J,I)),J=1,4)
201c print *,'N_N(I),I=',N_N(I),I
202c print *,'NVOISIN(1,I)=',(ITAB(NVOISIN(J,I)),J=1,N_N(I))
203c END DO
204 RETURN
205 END
206!||====================================================================
207!|| comm_seg_en ../starter/source/interfaces/inter3d1/i24inisu_nei.F
208!||--- called by ------------------------------------------------------
209!|| i24inisur_nei ../starter/source/interfaces/inter3d1/i24inisu_nei.F
210!||--- calls -----------------------------------------------------
211!|| comm_seg_e ../starter/source/interfaces/inter3d1/i24inisu_nei.F
212!|| comm_seg_n ../starter/source/interfaces/inter3d1/i24inisu_nei.F
213!|| re_ori ../starter/source/interfaces/inter3d1/i24tools.F
214!|| removeic1 ../starter/source/interfaces/inter3d1/i24tools.F
215!|| seg_opp ../starter/source/interfaces/inter3d1/i24tools.F
216!||====================================================================
217 SUBROUTINE comm_seg_en(N1,IED1,N2,IED2,NE,ICE,ISELF,
218 . I1,I2,IRECT,IM2SH ,NN,ICN ,X ,IE,IN ,IRR)
219C----6---------------------------------------------------------------7---------8
220C I m p l i c i t T y p e s
221C-----------------------------------------------
222#include "implicit_f.inc"
223C-----------------------------------------------------------------
224C D u m m y A r g u m e n t s
225C-----------------------------------------------
226 INTEGER N1,IED1(*),N2,IED2(*),NE,ICE(*),ISELF,IASYM,IRR,
227 . I1,I2,IRECT(4,*),NN,ICN(*),IE(*),IN(*),IM2SH(*)
228 my_real
229 . x(3,*)
230C-----------------------------------------------
231c FUNCTION: find neighbour segment and nodes which share the same nodes I1,I2
232c
233c Note:
234c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
235c
236c TYPE NAME FUNCTION
237c I N1,IED1(N1) - number and neighbour segment id list of node I1
238c I N2,IED2(N2) - number and neighbour segment id list of node I2
239c O NE,ICE(NE) - Number and neighbour segment id list of segment id ISELF
240c I ISELF,I1,I2 - input segment id ISELF w/ nodes I1,I2 (commun nodes)
241c I IRECT(4,*) - connectivity of segment id *
242c I X(3,*) - node coordinates
243c O NN,ICN(NN) - Number and neighbour node list
244c O IE(NE),IN(NN) - final (reduced) neighbour segment,node arries
245C-----------------------------------------------
246C L o c a l V a r i a b l e s
247C-----------------------------------------------
248 INTEGER I,J,NEW,K,M,NE0,NN0,DNE,IOP
249C---------------------
250 IRR = 0
251 ne0=ne
252 nn0=nn
253 iasym = iabs(im2sh(iself))
254C-------------neighbour segments-----------
255 CALL comm_seg_e(n1,ied1,n2,ied2,ne,ice,iself,
256 . i1,i2,irect,iasym )
257C-------------treatment of multi-neighbours (T form,shell) segments->reduce to 1----------
258 dne = ne-ne0
259 IF (dne > 1) THEN
260 CALL removeic1(dne,ice(ne0+1),iself,irect,x ,i1,i2,iasym,irr)
261 ne=ne0+1
262 END IF
263 IF (ice(ne)>0 )THEN
264 CALL seg_opp(iself,ice(ne),irect,x ,iop)
265 IF (iop > 0 ) ice(ne) = 0
266 END IF !(ICE(NE)>0 )THEN
267 CALL comm_seg_n(ne0,ne,ice,nn,icn,iself,i1,i2,irect)
268C-------------after convention--------------
269 IF ((nn-nn0)==2) CALL re_ori(i1,i2,icn(nn0+1),x )
270C
271 IF ((ne-ne0) >1 .OR.(nn-nn0)> 2) THEN
272C print *,'!!!error (report to developer)!!!',(NE-NE0),(NN-NN0)
273 irr=12
274 END IF
275 DO i=1+ne0,ne
276 ie(i)=ice(i)
277 END DO
278 DO i=1+nn0,nn
279 in(i)=icn(i)
280 END DO
281C----6---------------------------------------------------------------7---------8
282 RETURN
283 END
284!||====================================================================
285!|| comm_seg_e ../starter/source/interfaces/inter3d1/i24inisu_nei.F
286!||--- called by ------------------------------------------------------
287!|| comm_seg_en ../starter/source/interfaces/inter3d1/i24inisu_nei.F
288!||--- calls -----------------------------------------------------
289!|| add_id ../starter/source/interfaces/inter3d1/i24tools.F
290!|| intab ../starter/source/interfaces/inter3d1/i24tools.F
291!|| same_seg ../starter/source/interfaces/inter3d1/i24tools.F
292!||====================================================================
293 SUBROUTINE comm_seg_e(N1,IED1,N2,IED2,N,IC,ISELF,
294 . I1,I2,IRECT,IASYM)
295C----6---------------------------------------------------------------7---------8
296C I m p l i c i t T y p e s
297C-----------------------------------------------
298#include "implicit_f.inc"
299C-----------------------------------------------------------------
300C D u m m y A r g u m e n t s
301C-----------------------------------------------
302 INTEGER N1,IED1(*),N2,IED2(*),N,IC(*),ISELF,
303 . I1,I2,IRECT(4,*),IASYM
304C-----------------------------------------------
305c FUNCTION: find neighbour segment which shares the same nodes I1,I2
306c ---neighbour node array will be built after taking into account treatment w/ IC
307c (only one segment remains at the end)
308c
309c Note:
310c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
311c
312c TYPE NAME FUNCTION
313c I N1,IED1(N1) - number and neighbour segment id list of node I1
314c I N2,IED2(N2) - number and neighbour segment id list of node I2
315c O N,IC(N) - Number and neighbour segment id list of segment id ISELF
316c I ISELF,I1,I2 - input segment id ISELF w/ nodes I1,I2 (commun nodes)
317c I IRECT(4,*) - connectivity of segment id *
318C-----------------------------------------------
319C External function
320C-----------------------------------------------
321 LOGICAL INTAB,SAME_SEG
322 EXTERNAL INTAB,SAME_SEG
323C-----------------------------------------------
324C L o c a l V a r i a b l e s
325C-----------------------------------------------
326 INTEGER I,J,NEW,K,M,LING,NE,NN
327 DATA LING/0/
328C----add commun ID--at end--------------------------
329 IF (I1==i2) THEN
330C----add 0 in IC as convention ----------------------------
331 CALL add_id(n,ic,ling)
332 ELSE
333 ne=n
334 DO j=1,n2
335 new=ied2(j)
336 IF (new==iself.OR.new==iasym) cycle
337 IF (intab(n1,ied1,new)) THEN
338 IF (.NOT.same_seg(irect(1,iself),irect(1,new)))
339 . CALL add_id(n,ic,new)
340 END IF
341 END DO
342C----add 0 for IC if find nothing -> consisting w/ ICN------------------------
343 IF (ne==n) CALL add_id(n,ic,ling)
344 END IF !(I1==I2) THEN
345C----6---------------------------------------------------------------7---------8
346 RETURN
347 END
348!||====================================================================
349!|| comm_seg_n ../starter/source/interfaces/inter3d1/i24inisu_nei.F
350!||--- called by ------------------------------------------------------
351!|| comm_seg_en ../starter/source/interfaces/inter3d1/i24inisu_nei.F
352!||--- calls -----------------------------------------------------
353!|| add_n_id ../starter/source/interfaces/inter3d1/i24tools.F
354!||====================================================================
355 SUBROUTINE comm_seg_n(NE0,NE,ICE,NN,ICN,ISELF,I1,I2,IRECT)
356C----6---------------------------------------------------------------7---------8
357C I m p l i c i t T y p e s
358C-----------------------------------------------
359#include "implicit_f.inc"
360C-----------------------------------------------------------------
361C D u m m y A r g u m e n t s
362C-----------------------------------------------
363 INTEGER NE0,NE,ICE(*),NN,ICN(*),ISELF,I1,I2,IRECT(4,*)
364C-----------------------------------------------
365c FUNCTION: find neighbour nodes and which share the same nodes I1,I2
366c----------maximum 2 nodes will be chosen par two commun nodes I1,I2
367c Note:
368c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
369c
370c TYPE NAME FUNCTION
371c O NE0,NE,ICE(NE) - Number and neighbour seg id
372c I ISELF,I1,I2 - input segment id ISELF w/ nodes I1,I2 (commun nodes)
373c I IRECT(4,*) - connectivity of segment id *
374c O NN,ICN(NN) - Number and neighbour node list
375C-----------------------------------------------
376C L o c a l V a r i a b l e s
377C-----------------------------------------------
378 INTEGER I,J,NEW,K,M,LING,NN0
379 DATA LING/0/
380C----add commun ID--at end--------------------------
381 IF (I1==i2) THEN
382C----add 0 in ICN as convention ----------------------------
383 CALL add_n_id(nn,icn,ling)
384 CALL add_n_id(nn,icn,ling)
385 ELSE
386 nn0=nn
387 DO j=ne0+1,ne
388 new=ice(j)
389 IF (new ==0) cycle
390 DO k=1,3
391 m=irect(k,new)
392 IF (m/=i1.AND.m/=i2) CALL add_n_id(nn,icn,m)
393 END DO
394 m=irect(4,new)
395 IF (m /= irect(3,new)) THEN
396 IF (m/=i1.AND.m/=i2) CALL add_n_id(nn,icn,m)
397 ELSE
398C----add 0 for tria ----------------------------
399 CALL add_n_id(nn,icn,ling)
400 END IF
401 END DO
402C----add 0 for IC if find nothing -> consisting w/ ICN------------------------
403 IF (nn==nn0) THEN
404 CALL add_n_id(nn,icn,ling)
405 CALL add_n_id(nn,icn,ling)
406 END IF
407 END IF !(I1==I2) THEN
408C----6---------------------------------------------------------------7---------8
409 RETURN
410 END
411!||====================================================================
412!|| i24ini_gap_n ../starter/source/interfaces/inter3d1/i24inisu_nei.F
413!||--- called by ------------------------------------------------------
414!|| inint3 ../starter/source/interfaces/inter3d1/inint3.f
415!||====================================================================
416 SUBROUTINE i24ini_gap_n(
417 1 NRTM ,IRECT ,IXS ,GEO ,IXC ,IXTG ,
418 2 IXT ,IXP ,IPART ,IPARTC ,IPARTTG ,
419 3 THK ,THK_PART,NVOISIN ,GAP_N ,GAP_M ,
420 4 NMN ,MSR ,GAPN_M,GAP_N0,INTPLY ,
421 5 GAPMAX_M ,IGEO,MSEGTYP)
422C-----------------------------------------------
423C I m p l i c i t T y p e s
424C-----------------------------------------------
425#include "implicit_f.inc"
426C-----------------------------------------------
427C C o m m o n B l o c k s
428C-----------------------------------------------
429#include "com01_c.inc"
430#include "com04_c.inc"
431#include "param_c.inc"
432#include "scr17_c.inc"
433C-----------------------------------------------
434C D u m m y A r g u m e n t s
435C-----------------------------------------------
436 INTEGER NRTM,IRECT(4,*), IXS(NIXS,*), IXC(NIXC,*),
437 . IXTG(NIXTG,*), IXT(NIXT,*), IXP(NIXP,*),
438 . IPART(LIPART1,*), IPARTC(*), IPARTTG(*),
439 . NVOISIN(8,*),MSR(*),NMN,INTPLY,IGEO(NPROPGI,*),
440 . MSEGTYP(*)
441C REAL
442 my_real
443 . GEO(NPROPG,*), THK(*),THK_PART(*),GAP_N(12,*),GAP_M(*),
444 . GAPN_M(*),GAP_N0(12,*),GAPMAX_M
445C-----------------------------------------------
446C L o c a l V a r i a b l e s
447C-----------------------------------------------
448 INTEGER I,J,K,IW,I1,I2,I3,MG,M,IP,IGTYP
449 my_real
450 . WA(NUMNOD),DX
451C init
452C
453 DO i=1,numnod
454 wa(i)=zero
455 END DO
456C
457C------------------------------------
458C GAP NOEUDS IN WA
459C------------------------------------
460 DO i=1,numelc
461 mg=ixc(6,i)
462 igtyp = igeo(11,mg)
463 ip = ipartc(i)
464 IF ( thk_part(ip) /= zero .AND. iintthick == 0) THEN
465 dx=half*thk_part(ip)
466 ELSEIF ( thk(i) /= zero .AND. iintthick == 0) THEN
467 dx=half*thk(i)
468 ELSEIF(igtyp == 17) THEN
469 dx=half*thk(i)
470 ELSE
471 dx=half*geo(1,mg)
472 ENDIF
473 wa(ixc(2,i))=max(wa(ixc(2,i)),dx)
474 wa(ixc(3,i))=max(wa(ixc(3,i)),dx)
475 wa(ixc(4,i))=max(wa(ixc(4,i)),dx)
476 wa(ixc(5,i))=max(wa(ixc(5,i)),dx)
477 ENDDO
478C
479 DO i=1,numeltg
480 mg=ixtg(5,i)
481 igtyp = igeo(11,mg)
482 ip = iparttg(i)
483 IF ( thk_part(ip) /= zero .AND. iintthick == 0) THEN
484 dx=half*thk_part(ip)
485 ELSEIF ( thk(numelc+i) /= zero .AND. iintthick == 0) THEN
486 dx=half*thk(numelc+i)
487 ELSEIF(igtyp == 17) THEN
488 dx=half*thk(numelc+i)
489 ELSE
490 dx=half*geo(1,mg)
491 ENDIF
492 wa(ixtg(2,i))=max(wa(ixtg(2,i)),dx)
493 wa(ixtg(3,i))=max(wa(ixtg(3,i)),dx)
494 wa(ixtg(4,i))=max(wa(ixtg(4,i)),dx)
495 ENDDO
496C--------exclude lines in main surfaces
497C DO I=1,NUMELT
498C MG=IXT(4,I)
499C DX=HALF*SQRT(GEO(1,MG))
500C WA(IXT(2,I))=MAX(WA(IXT(2,I)),DX)
501C WA(IXT(3,I))=MAX(WA(IXT(3,I)),DX)
502C ENDDO
503C
504C DO I=1,NUMELP
505C MG=IXP(5,I)
506C DX=HALF*SQRT(GEO(1,MG))
507C WA(IXP(2,I))=MAX(WA(IXP(2,I)),DX)
508C WA(IXP(3,I))=MAX(WA(IXP(3,I)),DX)
509C ENDDO
510C------------------------------------
511C INI GAP_N (4 + 8 voisins), GAP_M is modified taking into account nodal gap
512C------------------------------------
513C -----due to the fact that if surf_M does not contain the defining w/ shell
514C-------> should not take into account GAP_shell
515 DO i=1,nrtm
516 IF (msegtyp(i)==0) THEN
517 DO j=1,4
518 m=irect(j,i)
519 wa(m) = zero
520 END DO
521 END IF !(MSEGTYP(I)==0) THEN
522 END DO ! nrtm
523C
524 DO i=1,nmn
525 m = msr(i)
526 wa(m) = min(wa(m),gapmax_m)
527 gapn_m(i) = wa(m)
528 END DO
529C
530 IF(intply == 0) THEN
531 DO i=1,nrtm
532 gap_m(i) = zero
533 DO j=1,4
534 m=irect(j,i)
535 gap_n(j,i)=wa(m)
536 gap_m(i) = max(gap_m(i),wa(m))
537 END DO
538C
539 DO j= 1,8
540 m=iabs(nvoisin(j,i))
541 IF (m > 0) THEN
542 gap_n(j+4,i)=wa(m)
543 ELSE
544 gap_n(j+4,i)=zero
545 END IF
546 END DO
547 END DO ! nrtm
548 ELSE
549 DO i=1,nrtm
550 gap_m(i) = zero
551 DO j=1,4
552 m=irect(j,i)
553 gap_n(j,i)=wa(m)
554 gap_m(i) = max(gap_m(i),wa(m))
555 gap_n0(j,i) = gap_n(j,i)
556 END DO
557C
558 DO j= 1,8
559 m=iabs(nvoisin(j,i))
560 IF (m >0) THEN
561 gap_n(j+4,i)=wa(m)
562 gap_n0(j+4,i) = wa(m)
563 ELSE
564 gap_n(j+4,i)=zero
565 gap_n0(j+4,i) = zero
566 END IF
567 END DO
568 END DO ! nrtm
569 ENDIF ! intply
570C-----reset MSEGTYP(I)=0 for coating shell, engine uses MSEGTYP only for symmetry
571 DO i=1,nrtm
572 IF (msegtyp(i)>nrtm) msegtyp(i) =0
573 END DO ! nrtm
574C
575 RETURN
576 END
my_real
#define my_real
Definition cppsort.cpp:32
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
comm_seg_e
subroutine comm_seg_e(n1, ied1, n2, ied2, n, ic, iself, i1, i2, irect, iasym)
Definition i24inisu_nei.F:295
i24inisur_nei
subroutine i24inisur_nei(nrtm, nsn, irect, irtlm, mvoisin, nvoisin, mseglo, msegtyp, itab, x, id, titr, igeo)
Definition i24inisu_nei.F:35
comm_seg_n
subroutine comm_seg_n(ne0, ne, ice, nn, icn, iself, i1, i2, irect)
Definition i24inisu_nei.F:356
comm_seg_en
subroutine comm_seg_en(n1, ied1, n2, ied2, ne, ice, iself, i1, i2, irect, im2sh, nn, icn, x, ie, in, irr)
Definition i24inisu_nei.F:219
seg_opp
subroutine seg_opp(ei, ej, irect, x, iop)
Definition i24tools.F:375
re_ori
subroutine re_ori(i1, i2, in, x)
Definition i24tools.F:224
add_n_id
subroutine add_n_id(n, ic, id)
Definition i24tools.F:59
removeic1
subroutine removeic1(n, ic, iself, irect, x, i1, i2, iasym, irr)
Definition i24tools.F:546
msg_err
subroutine msg_err(i1, i2, itab, irr, id, titr)
Definition i24tools.F:271
add_id
subroutine add_id(n, ic, id)
Definition i24tools.F:30
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
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
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
starter
program starter
Definition starter.F:39