OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
qgrhead.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!|| qgrhead ../starter/source/elements/solid_2d/quad/qgrhead.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!||--- uses -----------------------------------------------------
31!|| message_mod ../starter/share/message_module/message_mod.F
32!||====================================================================
33 SUBROUTINE qgrhead(
34 1 IXQ ,PM ,GEO ,INUM ,ISEL ,
35 2 ITR1 ,EADD ,INDEX ,ITRI ,IPARTQ ,
36 3 ND ,IGRSURF ,IGRQUAD ,CEP ,MAT_PARAM,
37 5 XEP ,IGEO ,IPM ,IQUAOFF ,TRIMAT)
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE message_mod
42 USE groupdef_mod
43 USE matparam_def_mod
44 USE names_and_titles_mod , ONLY : nchartitle
45C-----------------------------------------------
46C A R G U M E N T S
47C-----------------------------------------------
48C IXQ(7,NUMELQ) TABLEAU CONECS+PID+MID+NOS SOLIDES 4N E
49C PM(NPROPM,NUMMAT) ARRAY OF MATERIAL PROPERTIES E
50C GEO(NPROPG,NUMGEO) ARRAY OF PID CHARACTERISTICS E
51C INUM(8,NUMELQ) TABLEAU DE TRAVAIL E/S
52C ISEL(NSELQ) TABLEAU DES SOLIDES 4N CHOISIS POUR TH E/S
53C ITR1(NSELQ) TABLEAU DE TRAVAIL E/S
54C EADD(NUMELQ) TABLEAU DES ADRESEES DANS IDAM CHGT DAMIER S
55C INDEX(NUMELQ) TABLEAU DE TRAVAIL E/S
56C ITRI(5,NUMELQ) TABLEAU DE TRAVAIL E/S
57C IPARTQ(NUMELQ) TABLEAU PART E/S
58C CEP(NUMELQ) TABLEAU DE TRAVAIL E/S
59C XEP(NUMELQ) TABLEAU DE TRAVAIL E/S
60C IQUAOFF(NUMELQ) FLAG ELEM RBY ON/OFF E/S
61C-----------------------------------------------
62C I M P L I C I T T Y P E S
63C-----------------------------------------------
64#include "implicit_f.inc"
65C-----------------------------------------------
66C C O M M O N B L O C K S
67C-----------------------------------------------
68#include "vect01_c.inc"
69#include "com04_c.inc"
70#include "param_c.inc"
71#include "scr17_c.inc"
72C-----------------------------------------------
73C D U M M Y A R G U M E N T S
74C-----------------------------------------------
75 INTEGER IXQ(7,*),ISEL(*),INUM(9,*),IPARTQ(*),
76 . EADD(*),ITR1(*),INDEX(*),ITRI(5,*),ND, CEP(*),XEP(*),
77 . IGEO(NPROPGI,NUMGEO), IPM(NPROPMI,NUMMAT),
78 . IQUAOFF(*)
79 my_real :: pm(npropm,nummat), geo(npropg,numgeo)
80C-----------------------------------------------
81 TYPE (GROUP_) , DIMENSION(NGRQUAD) :: IGRQUAD
82 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
83 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT),INTENT(IN) :: MAT_PARAM
84 INTEGER,INTENT(INOUT) :: TRIMAT
85C-----------------------------------------------
86C L O C A L V A R I A B L E S
87C-----------------------------------------------
88 INTEGER
89 . I,J,K, NN, MLN, MID, PID ,
90 . II,JJ, II1,JJ1,II2,JJ2,II3,JJ3,II4,JJ4,
91 . MODE, ML1, ML2, MT1, MT2,IGT,
92 . mskmln,mskjal,mskmid,mskpid,ieos,
93 . mskjeu,mskjtu,mskjth,mskjpo,
94 . iplast,irep,ifail,irb,
95 . jale_from_mat,jale_from_prop
96 INTEGER ID
97 CHARACTER(LEN=NCHARTITLE)::TITR
98 INTEGER WORK(70000)
99 EXTERNAL MY_SHIFTL,MY_SHIFTR,MY_AND
100 INTEGER MY_SHIFTL,MY_SHIFTR,MY_AND
101C
102 DATA mskmln /o'07770000000'/
103 DATA mskjal /o'00000070000'/
104 DATA mskjeu /o'00000007000'/
105 DATA mskjtu /o'00000000700'/
106 DATA mskjth /o'00000000070'/
107 DATA mskjpo /o'00000000007'/
108 DATA mskmid /o'07777777777'/
109 DATA mskpid /o'07777777777'/
110C
111C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
112
113C----------------------------------------------------------
114C GLOBAL SORT ON ALL CRITERIA FOR ALL ELEMENTS
115C----------------------------------------------------------
116C
117 DO i=1,numelq
118 eadd(i)=1
119 itri(4,i)=i
120 index(i)=i
121 inum(1,i)=ipartq(i)
122 inum(2,i)=ixq(1,i)
123 inum(3,i)=ixq(2,i)
124 inum(4,i)=ixq(3,i)
125 inum(5,i)=ixq(4,i)
126 inum(6,i)=ixq(5,i)
127 inum(7,i)=ixq(6,i)
128 inum(8,i)=ixq(7,i)
129 inum(9,i)=iquaoff(i)
130 ENDDO
131C
132 DO i=1,numelq
133 xep(i)=cep(i)
134 ENDDO
135C
136C
137 DO i = 1, numelq
138 ii = i
139 npt=1
140 jpor=0
141 mid= ixq(1,ii)
142 pid= ixq(6,ii)
143 iplast= 1
144 irep = 0
145 jcvt = 0
146 ifail = 0
147 ieos = 0
148 IF (pid/=0) THEN
149 igt = igeo(11,pid)
150 IF (igt /= 15) iplast = igeo(9,pid)
151 IF (igt==15)jpor=2*nint(geo(28,pid))
152 jcvt = igeo(16,pid)
153 ENDIF
154 mln = nint(pm(19,abs(mid)))
155 IF(mln == 51)trimat=4
156 IF(mid<0)THEN
157 IF(mln==6.AND.jpor/=2)mln=17
158 IF(mln==46)mln=47
159 mid=iabs(mid)
160 ENDIF
161 ifail = mat_param(mid)%NFAIL
162 jale_from_mat = nint(pm(72,mid))
163 jale_from_prop = igeo(62,pid)
164 jale = max(jale_from_mat, jale_from_prop) !if inconsistent, error message was displayed in PART reader
165 jlag=0
166 IF(jale==0.AND.mln/=18)jlag=1
167 jeul=0
168 IF(jale==2)THEN
169 jale=0
170 jeul=1
171 ENDIF
172 jtur=nint(pm(70,mid))
173 jthe=nint(pm(71,mid))
174 jmult=0
175 IF(mln==20)THEN
176 jmult=nint(pm(20,mid))
177 mt1=nint(pm(21,mid))
178 mt2=nint(pm(22,mid))
179 ml1=nint(pm(19,mt1))
180 ml2=nint(pm(19,mt2))
181 ELSE
182 jmult=0
183 ml1=0
184 ml2=0
185 ENDIF
186C
187 IF(jcvt/=0.AND.(jlag==0.OR.mln==20))THEN
188 id=igeo(1,pid)
189 CALL fretitl2(titr,
190 . igeo(npropgi-ltitr+1,pid),ltitr)
191 CALL ancmsg(msgid=608,
192 . msgtype=msgwarning,
193 . anmode=aninfo_blind_1,
194 . i1=id,
195 . c1=titr,
196 . i2=ixq(7,i))
197 jcvt=0
198 END IF
199 ieos = ipm(4,mid)
200C sort on elem deletes rigidbody
201C IRB = 0 : elem actif
202C IRB = 1 : inactive elem and optimized for SPMD
203C IRB = 2: Elem inactive but optimized to be active in SPMD
204 irb = iquaoff(i)
205C
206C Npt = 1;Jhbe = 0;Jivf = 0 and jlag not used
207C Key 1---------------------------------
208 jpor=my_shiftl(jpor,0)
209 jthe=my_shiftl(jthe,3)
210 jtur=my_shiftl(jtur,6)
211 jeul=my_shiftl(jeul,9)
212 jale=my_shiftl(jale,12)
213 mln=my_shiftl(mln,21)
214c IRB=MY_SHIFTL(IRB,0)
215 itri(1,i)=mln+jale+jeul+jtur+jthe+jpor+irb
216C Key 2---------------------------------
217 iplast=my_shiftl(iplast,0)
218 ifail = my_shiftl(ifail,3)
219 ml1=my_shiftl(ml1,5)
220 ml2=my_shiftl(ml2,13)
221 igt=my_shiftl(igt,21)
222 jcvt=my_shiftl(jcvt,28)
223 itri(2,i)=iplast+ml1+ml2+igt+jcvt + ifail
224C Key 3---------------------------------
225 itri(3,i)=mid
226C Key 4---------------------------------
227 itri(4,i)=pid
228C Key 5---------------------------------
229 ieos = my_shiftl(ieos,0)
230C next = MY_SHIFTL(next,4)
231 itri(5,i)=ieos
232
233 ENDDO
234C
235 mode=0
236 CALL my_orders( mode, work, itri, index, numelq , 5)
237C
238 DO i=1,numelq
239 ipartq(i) =inum(1,index(i))
240 iquaoff(i) = inum(9,index(i))
241 ENDDO
242 DO i=1,numelq
243 cep(i)=xep(index(i))
244 ENDDO
245 DO k=1,7
246 DO i=1,numelq
247 ixq(k,i)=inum(k+1,index(i))
248 ENDDO
249 ENDDO
250
251C
252C INVERSE OF INDEX (ITR1)
253C
254 DO i=1,numelq
255 itr1(index(i))=i
256 ENDDO
257
258
259C
260C SURFACE RENUMBERING
261C
262 DO i=1,nsurf
263 nn=igrsurf(i)%NSEG
264 DO j=1,nn
265 IF(igrsurf(i)%ELTYP(j) == 2) igrsurf(i)%ELEM(j) = itr1(igrsurf(i)%ELEM(j))
266 ENDDO
267 ENDDO
268C
269C RSOLID GROUPS RENUMBERING
270C
271 DO i=1,ngrquad
272 nn=igrquad(i)%NENTITY
273 DO j=1,nn
274 igrquad(i)%ENTITY(j) = itr1(igrquad(i)%ENTITY(j))
275 ENDDO
276 ENDDO
277C
278C--------------------------------------------------------------
279C BUILDING SUPER GROUPS
280C--------------------------------------------------------------
281 nd=1
282 DO i=2,numelq
283 ii=itri(1,index(i))
284 jj=itri(1,index(i-1))
285 ii1=itri(2,index(i))
286 jj1=itri(2,index(i-1))
287 ii2=itri(3,index(i))
288 jj2=itri(3,index(i-1))
289 ii3=itri(4,index(i))
290 jj3=itri(4,index(i-1))
291 ii4=itri(5,index(i))
292 jj4=itri(5,index(i-1))
293 IF(ii/=jj.OR.
294 . ii1/=jj1.OR.
295 . ii4/=jj4.OR.
296 . ii2/=jj2.OR.
297 . ii3/=jj3) THEN
298 nd=nd+1
299 eadd(nd)=i
300 ENDIF
301 ENDDO
302 eadd(nd+1) = numelq+1
303C
304 RETURN
305 END
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
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: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
qgrhead
subroutine qgrhead(ixq, pm, geo, inum, isel, itr1, eadd, index, itri, ipartq, nd, igrsurf, igrquad, cep, mat_param, xep, igeo, ipm, iquaoff, trimat)
Definition qgrhead.F:38
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