OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pgrhead.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!|| pgrhead ../starter/source/elements/beam/pgrhead.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!||====================================================================
30 SUBROUTINE pgrhead(
31 1 IXP ,PM ,GEO ,INUM ,
32 2 ITR1 ,EADD ,INDEX ,ITRI ,IPARTP ,
33 3 ND ,IGRSURF,IGRBEAM ,CEP ,
34 4 XEP ,IGEO ,IPOUOFF ,TAGPRT_SMS ,IPM ,
35 5 ITAGPRLD_BEAM,IBEAM_VECTOR,RBEAM_VECTOR,XNUM)
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE groupdef_mod
40C-----------------------------------------------
41C A R G U M E N T S
42C-----------------------------------------------
43C IXP(6,NUMELP) TABLEAU CONECS+MID+PID+NOS POUTRES E
44C GEO(NPROPG,NUMGEO)TABLEAU DES CARACS DES PID E
45C INUM(7,NUMELP) TABLEAU DE TRAVAIL E/S
46C ITR1(NSELP) TABLEAU DE TRAVAIL E/S
47C EADD(NUMELP) TABLEAU DES ADRESSES DANS IDAM CHGT DAMIER S
48C INDEX(NUMELP) TABLEAU DE TRAVAIL E/S
49C ITRI(5,NUMELP) TABLEAU DE TRAVAIL E/S
50C IPARTP(NUMELP) TABLEAU PART E/S
51C CEP(NUMELP) TABLEAU PROC E/S
52C XEP(NUMELP) TABLEAU PROC E/S
53C-----------------------------------------------
54C I M P L I C I T T Y P E S
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C C O M M O N B L O C K S
59C-----------------------------------------------
60#include "vect01_c.inc"
61#include "com04_c.inc"
62#include "param_c.inc"
63#include "sms_c.inc"
64C-----------------------------------------------
65C D U M M Y A R G U M E N T S
66C-----------------------------------------------
67 INTEGER IXP(6,*),INUM(9,*),IPARTP(*),IGEO(NPROPGI,NUMGEO),
68 . EADD(*),ITR1(*),INDEX(*),ITRI(5,NUMELP),
69 . ND, CEP(*), XEP(*),IPOUOFF(*),
70 . TAGPRT_SMS(*),IPM(NPROPMI,NUMMAT)
71 INTEGER ,INTENT(INOUT), DIMENSION(NUMELP) ::ITAGPRLD_BEAM
72 INTEGER ,INTENT(INOUT) :: IBEAM_VECTOR(NUMELP)
73 my_real PM(NPROPM,NUMMAT), GEO(NPROPG,NUMGEO)
74 my_real ,INTENT(INOUT) :: RBEAM_VECTOR(3,NUMELP)
75 my_real ,INTENT(INOUT) :: XNUM(3,NUMELP)
76C-----------------------------------------------
77 TYPE (GROUP_) , DIMENSION(NGRBEAM) :: IGRBEAM
78 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
79C-----------------------------------------------
80C L O C A L V A R I A B L E S
81C-----------------------------------------------
82 INTEGER :: I, K, MLN, ISSN, NN, MID, PID,IGTYP
83 INTEGER :: II, J, II2,JJ2,JJ,II3,JJ3,II4,JJ4,II5,JJ5,NPG,MODE
84 INTEGER :: WORK(70000)
85 INTEGER MY_SHIFTL,MY_SHIFTR,MY_AND,IPRLD
86 EXTERNAL MY_SHIFTL,MY_SHIFTR,MY_AND
87C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
88C TRI GLOBAL SUR TOUS LES CRITERES POUR TOUS LES ELEMENTS
89C----------------------------------------------------------
90C
91 DO i=1,numelp
92 eadd(i)=1
93 index(i)=i
94 inum(1,i)=ipartp(i)
95 inum(2,i)=ixp(1,i)
96 inum(3,i)=ixp(2,i)
97 inum(4,i)=ixp(3,i)
98 inum(5,i)=ixp(4,i)
99 inum(6,i)=ixp(5,i)
100 inum(7,i)=ixp(6,i)
101 inum(8,i)=ipouoff(i)
102 inum(9,i)=ibeam_vector(i)
103 xnum(1:3,i)=rbeam_vector(1:3,i)
104 ENDDO
105
106 DO i=1,numelp
107 xep(i)=cep(i)
108 ENDDO
109C
110C
111 DO i = 1, numelp
112 ii = i
113 mid= ixp(1,ii)
114 mln= int(pm(19,mid))
115 pid= ixp(5,ii)
116 issn = 0
117 IF(geo(5,pid)/=zero) issn=1
118 iprld = itagprld_beam(ii)
119 npg = igeo(3,pid)
120 igtyp = igeo(11,pid) + iprld
121 jthe = nint(pm(71,mid))
122 iexpan = ipm(218,mid)
123c
124 igtyp = my_shiftl(igtyp,12)
125 issn = my_shiftl(issn,6)
126 jthe = my_shiftl(jthe,9)
127 iexpan = my_shiftl(iexpan,12)
128 mln = my_shiftl(mln,21)
129C
130 itri(1,i) = mln + igtyp + issn + jthe + iexpan
131 itri(2,i) = ipouoff(i)
132C
133 jsms = 0
134 IF(isms/=0)THEN
135 IF(idtgrs/=0)THEN
136 IF(tagprt_sms(ipartp(ii))/=0)jsms=1
137 ELSE
138 jsms=1
139 END IF
140 END IF
141C JSMS = MY_SHIFTL(JSMS,0)
142 npg = my_shiftl(npg,12)
143 itri(3,i) = jsms+npg
144C NEXT = MY_SHIFTL(NEXT,1)
145
146C--- Key 4
147C MID = MY_SHIFTL(MID,0)
148 itri(4,i) = mid
149C--- Key 5
150C PID = MY_SHIFTL(PID,0)
151 itri(5,i) = pid
152
153 ENDDO
154C
155 mode=0
156 CALL my_orders( mode, work, itri, index, numelp , 5)
157C
158 DO i=1,numelp
159 ipartp(i) = inum(1,index(i))
160 ipouoff(i)= inum(8,index(i))
161 ibeam_vector(i)= inum(9,index(i))
162 rbeam_vector(1:3,i)= xnum(1:3,index(i))
163 ENDDO
164 DO i=1,numelp
165 cep(i)=xep(index(i))
166 ENDDO
167 DO k=1,6
168 DO i=1,numelp
169 ixp(k,i)=inum(k+1,index(i))
170 ENDDO
171 ENDDO
172C
173C INVERSION DE INDEX (DANS ITR1)
174C
175 DO i=1,numelp
176 itr1(index(i))=i
177 ENDDO
178C
179C RENUMEROTATION POUR SURFACES
180C
181 DO i=1,nsurf
182 nn=igrsurf(i)%NSEG
183 DO j=1,nn
184 IF(igrsurf(i)%ELTYP(j) == 5)
185 . igrsurf(i)%ELEM(j) = itr1(igrsurf(i)%ELEM(j))
186 ENDDO
187 ENDDO
188C
189C RENUMEROTATION POUR GROUPES DE POUTRES
190C
191 DO i=1,ngrbeam
192 nn=igrbeam(i)%NENTITY
193 DO j=1,nn
194 igrbeam(i)%ENTITY(j) = itr1(igrbeam(i)%ENTITY(j))
195 ENDDO
196 ENDDO
197C REORDERING FOR ITAGPRLD_BEAM
198 inum(8,1:numelp)=itagprld_beam(1:numelp)
199 DO i=1,numelp
200 itagprld_beam(i) = inum(8,index(i))
201 ENDDO
202C
203C--------------------------------------------------------------
204C DETERMINATION DES SUPER_GROUPES
205C--------------------------------------------------------------
206 nd=1
207 DO i=2,numelp
208 ii = itri(1,index(i))
209 jj = itri(1,index(i-1))
210 ii2 = itri(2,index(i))
211 jj2 = itri(2,index(i-1))
212 ii3 = itri(3,index(i))
213 jj3 = itri(3,index(i-1))
214 ii4 = itri(4,index(i))
215 jj4 = itri(4,index(i-1))
216 ii5 = itri(5,index(i))
217 jj5 = itri(5,index(i-1))
218 IF (ii/=jj .OR. ii2/=jj2 .OR. ii3/=jj3 .OR. ii4/=jj4 .OR. ii5/=jj5) THEN
219 nd=nd+1
220 eadd(nd)=i
221 ENDIF
222 ENDDO
223 eadd(nd+1) = numelp+1
224C
225 RETURN
226 END
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
pgrhead
subroutine pgrhead(ixp, pm, geo, inum, itr1, eadd, index, itri, ipartp, nd, igrsurf, igrbeam, cep, xep, igeo, ipouoff, tagprt_sms, ipm, itagprld_beam, ibeam_vector, rbeam_vector, xnum)
Definition pgrhead.F:36