OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
xgrhead.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!|| xgrhead ../starter/source/elements/xelem/xgrhead.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!||--- uses -----------------------------------------------------
30!|| message_mod ../starter/share/message_module/message_mod.F
31!||====================================================================
32 SUBROUTINE xgrhead(
33 1 KXX, GEO, INUM, ITR1,
34 2 EADD, INDEX, ITRI, IPARTX,
35 3 ND, IGRSURF,
36 4 CEP, XEP,IPM)
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE message_mod
41 USE groupdef_mod
42C-----------------------------------------------
43C A R G U M E N T S
44C-----------------------------------------------
45C KXX(5,NUMELX) TABLEAU CONECS+PID+No ElEMENTS MULTIBRIN E
46C GEO(NPROPG,NUMGEO)TABLEAU DES CARACS DES PID E
47C INUM(6,NUMELX) TABLEAU DE TRAVAIL E/S
48C ITR1(NSELR) TABLEAU DE TRAVAIL E/S
49C EADD(NUMELX) TABLEAU DES ADRESSES DANS IDAM CHGT DAMIER S
50C INDEX(NUMELX) TABLEAU DE TRAVAIL E/S
51C ITRI(4,NUMELX) TABLEAU DE TRAVAIL E/S
52C IPARTX(NUMELX) TABLEAU PART E/S
53C CEP(NUMELX) TABLEAU PROC E/S
54C XEP(NUMEX) TABLEAU PROC E/S
55C-----------------------------------------------
56C I M P L I C I T T Y P E S
57C-----------------------------------------------
58#include "implicit_f.inc"
59C-----------------------------------------------
60C C O M M O N B L O C K S
61C-----------------------------------------------
62#include "vect01_c.inc"
63#include "com04_c.inc"
64#include "param_c.inc"
65C-----------------------------------------------
66C D U M M Y A R G U M E N T S
67C-----------------------------------------------
68 INTEGER KXX(5,*),INUM(6,*),IPARTX(*),
69 . EADD(*),ITR1(*),INDEX(*),ITRI(4,*),
70 . ND, CEP(*), XEP(*),
71 . IPM(NPROPMI,*)
72 my_real :: geo(npropg,*)
73C-----------------------------------------------
74C L O C A L V A R I A B L E S
75C-----------------------------------------------
76 INTEGER
77 . I, K, NG, ISSN, NPN, NN, N, MID, PID ,
78 . II, J, II2,JJ2,JJ, II3, JJ3, L,NGROU,
79 . MSKMTN,MSKISN,MSKPID, MODE, WORK(70000)
80 EXTERNAL my_shiftl,my_shiftr,my_and
81 INTEGER MY_SHIFTL,MY_SHIFTR,MY_AND
82C
83 DATA MSKMTN /O'07770000000'/
84 DATA mskisn /o'00000000700'/
85 DATA mskpid /o'07777777777'/
86C
87 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
88C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
89C----------------------------------------------------------
90C TRI GLOBAL SUR TOUS LES CRITERES POUR TOUS LES ELEMENTS
91C----------------------------------------------------------
92C
93 DO i=1,numelx
94 eadd(i)=1
95 itri(4,i)=i
96 index(i)=i
97 inum(1,i)=ipartx(i)
98 inum(2,i)=kxx(1,i)
99 inum(3,i)=kxx(2,i)
100 inum(4,i)=kxx(3,i)
101 inum(5,i)=kxx(4,i)
102 inum(6,i)=kxx(5,i)
103 ENDDO
104
105 DO i=1,numelx
106 xep(i)=cep(i)
107 ENDDO
108
109 DO i = 1, numelx
110 mid= kxx(1,i)
111 pid= kxx(2,i)
112 mtn= nint(geo(12,pid))
113 IF (mtn<28.OR.mtn>31) THEN
114 CALL ancmsg(msgid=413,
115 . msgtype=msgerror,
116 . anmode=aninfo_blind_1,
117 . i1=kxx(5,i),
118 . c1='MATERIAL',
119 . i2=ipm(1,mid),
120 . c2='MATERIAL',
121 . i3=mtn)
122 ENDIF
123
124 issn = 0
125 IF(geo(5,pid)/=zero) issn=1
126C
127 issn=my_shiftl(issn,6)
128 mtn=my_shiftl(mtn,21)
129C
130 itri(1,i)=mtn+issn
131 itri(2,i)=pid
132 itri(3,i)=kxx(3,i)
133 itri(4,i)=0
134 ENDDO
135C
136 mode=0
137 CALL my_orders( mode, work, itri, index, numelx , 4)
138C
139 DO i=1,numelx
140 ipartx(i) =inum(1,index(i))
141 ENDDO
142 DO i=1,numelx
143 cep(i)=xep(index(i))
144 ENDDO
145 DO k=1,5
146 DO i=1,numelx
147 kxx(k,i)=inum(k+1,index(i))
148 ENDDO
149 ENDDO
150C
151C INVERSION DE INDEX (DANS ITR1)
152C
153 DO i=1,numelx
154 itr1(index(i))=i
155 ENDDO
156
157
158C
159C RENUMEROTATION POUR SURFACES
160C ow a verifier IBUFSSG - ITYP == 100
161 DO i=1,nsurf
162 nn=igrsurf(i)%NSEG
163 DO j=1,nn
164 IF(igrsurf(i)%ELTYP(j) == 100)
165 . igrsurf(i)%ELEM(j) = itr1(igrsurf(i)%ELEM(j))
166 ENDDO
167 ENDDO
168C--------------------------------------------------------------
169C DETERMINATION DES SUPER_GROUPES
170C--------------------------------------------------------------
171 nd=1
172 DO i=2,numelx
173 ii=itri(1,index(i))
174 jj=itri(1,index(i-1))
175 ii2=itri(2,index(i))
176 jj2=itri(2,index(i-1))
177 ii3=itri(3,index(i))
178 jj3=itri(3,index(i-1))
179 IF(ii/=jj.OR.ii2/=jj2.OR.ii3/=jj3) THEN
180 nd=nd+1
181 eadd(nd)=i
182 ENDIF
183 ENDDO
184 eadd(nd+1) = numelx+1
185C
186 RETURN
187 END
my_real
#define my_real
Definition cppsort.cpp:32
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
groupdef_mod
Definition groupdef_mod.F:662
message_mod
Definition message_mod.F:1249
my_shiftr
int my_shiftr(int *a, int *n)
Definition precision.c:45
my_shiftl
int my_shiftl(int *a, int *n)
Definition precision.c:36
my_and
int my_and(int *a, int *b)
Definition precision.c:54
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
xgrhead
subroutine xgrhead(kxx, geo, inum, itr1, eadd, index, itri, ipartx, nd, igrsurf, cep, xep, ipm)
Definition xgrhead.F:37