OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lecig3d.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!|| lecig3d ../starter/source/elements/ige3d/lecig3d.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.f
29!|| fredec0 ../starter/source/starter/freform.F
30!|| nodgrnr5 ../starter/source/starter/freform.F
31!|| udouble ../starter/source/system/sysfus.f
32!|| usr2sys ../starter/source/system/sysfus.F
33!||--- uses -----------------------------------------------------
34!|| format_mod ../starter/share/modules1/format_mod.F90
35!|| meshsurfig3d_mod ../starter/source/elements/ige3d/meshsurfig3d_mod.f
36!|| message_mod ../starter/share/message_module/message_mod.F
37!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
38!||====================================================================
39 SUBROUTINE lecig3d(ITAB ,IPART ,IPARTIG3D ,IPM ,IGEO ,
40 . KXIG3D ,IXIG3D ,ITABM1 ,NCTRLMAX, TABCONPATCH)
41C----------------------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE message_mod
45 USE meshsurfig3d_mod
46 USE format_mod , ONLY : fmt_10i, fmt_8i, fmt_2i
47 USE reader_old_mod , ONLY : kline, kcur, line, kige3d, koptad, irec
48C----------------------------------------------------------
49C LECTURE ELEMENT ISO GEOMETRIQUE
50C-----------------------------------------------
51C KXIG3D(1,*):IMID : ID DU MATERIAU
52C KXIG3D(2,*):IPID : ID DE LA PROPRIETE
53C KXIG3D(3,*):NNOD : NOMBRE DE POINTS DE CONTROLE DE L ELEMENT
54C KXIG3D(4,*):IAD : ADRESSE DE LA ZONE DES NOS DE NOEUDS DANS IXIG3D
55C IXIG3D(IAD) A IXIG3D(IAD+NNOD-1)
56C KXIG3D(5,*):ID : ID DE L'ELEMENT.
57C KXIG3D(6,*):ID : index of 1st knot in the Xknot vector corresponding to the element
58C KXIG3D(7,*):ID : index of 1st knot in the Yknot vector corresponding to the element
59C KXIG3D(8,*):ID : index of 1st knot in the Zknot vector corresponding to the element
60C KXIG3D(9,*):ID : index of 2nd knot in the Xknot vector corresponding to the element
61C KXIG3D(10,*):ID : index of 2nd knot in the Yknot vector corresponding to the element
62C KXIG3D(11,*):ID : index of 2nd knot in the Zknot vector corresponding to the element
63C KXIG3D(12,*): :
64C KXIG3D(13,*): :
65C KXIG3D(14,*): :
66C KXIG3D(15,*):ID : ID OF THE FIRST NODE FOR ANIMATION FILE (27 BRICKS)
67C-----------------------------------------------
68C I m p l i c i t T y p e s
69C-----------------------------------------------
70#include "implicit_f.inc"
71C-----------------------------------------------
72C C o m m o n B l o c k s
73C-----------------------------------------------
74#include "com04_c.inc"
75#include "scr17_c.inc"
76#include "units_c.inc"
77#include "param_c.inc"
78#include "ige3d_c.inc"
79C-----------------------------------------------
80C D u m m y A r g u m e n t s
81C-----------------------------------------------
82 INTEGER KXIG3D(NIXIG3D,*),IXIG3D(*),ITAB(*),
83 . ipart(lipart1,*),ipartig3d(*),
84 . ipm(npropmi,*),igeo(npropgi,*),itabm1(*),
85 . nctrlmax
86 TYPE(tabconpatch_ig3d_), DIMENSION(*) :: TABCONPATCH
87C-----------------------------------------------
88C L o c a l V a r i a b l e s
89C-----------------------------------------------
90 INTEGER I,N,J,ID,IDS,IDEX,IDGU,IGS,NNOD,IAD,
91 . i1, i2,mid,pid,idx1,idy1,idz1,nctrl,nbline,
92 . nrafx,nrafy,nrafz,nbig3d_patch
93 INTEGER TABIDS(NUMELIG3D0),J10(10)
94 CHARACTER MESS*40
95 my_real bid
96C-----------------------------------------------
97C E x t e r n a l F u n c t i o n s
98C-----------------------------------------------
99 INTEGER NODGRNR5,USR2SYS
100C-----------------------------------------------
101 DATA mess /'ISO-GEOMETRIC ELEMENTS DEFINITION '/
102C=======================================================================
103c
104 nbig3d_patch = 0
105 nbpart_ig3d = 0
106c
107 kcur = kige3d
108 nbpart_ig3d = nbpart_ig3d+1
109 tabconpatch(nbpart_ig3d)%ID_TABCON=nbpart_ig3d
110 irec = koptad(kcur)
111 irec=irec+1
112 READ(iin,rec=irec,err=999,fmt='(A)')line
113 DO WHILE( line(1:1) /= '/' .OR. line(1:6) == '/IGE3D')
114
115 IF (line(1:1) == '/')THEN ! CHANGEMENT DE PART
116 irec=irec+1
117 READ(iin,rec=irec,err=999,fmt='(A)')line
118 ENDIF
119
120 READ(line,err=999,fmt=fmt_8i)id,idx1,idy1,idz1,nctrl,nrafx,nrafy,nrafz
121 nbig3d_patch=nbig3d_patch+1
122 irec = irec + ((nctrl-1)/10)+2
123 READ(iin,rec=irec,err=999,fmt='(A)')line
124
125 IF (line(1:6) == '/IGE3D')THEN ! ON A ONE CHANGEMENT DE PART
126 tabconpatch(nbpart_ig3d)%L_TAB_IG3D=nbig3d_patch
127 ALLOCATE(tabconpatch(nbpart_ig3d)%TAB_IG3D(nbig3d_patch))
128 nbpart_ig3d = nbpart_ig3d+1
129 nbig3d_patch=0
130 irec=irec+1
131 READ(iin,rec=irec,err=999,fmt='(A)')line
132 ENDIF
133
134 ENDDO
135
136 tabconpatch(nbpart_ig3d)%L_TAB_IG3D=nbig3d_patch
137 ALLOCATE(tabconpatch(nbpart_ig3d)%TAB_IG3D(nbig3d_patch))
138
139 nbpart_ig3d = 0
140 nbig3d_patch = 0
141
142 bid =0
143 iad =1
144 kcur=kige3d
145 irec=koptad(kcur)-1
146 i = 0
147 inod_ige = firstnod_isogeo
148 ids=0
149 DO WHILE( i < numelig3d0 )
150 irec=irec+1
151 READ(iin,rec=irec,err=999,fmt='(A)')line
152 IF (line(1:1) == '/')THEN
153 nbpart_ig3d = nbpart_ig3d+1
154 nbig3d_patch = 0
155 kline=line
156 CALL fredec0(id)
157 ids=0
158 DO j=1,npart
159 IF(ipart(4,j) == id)ids=j
160 ENDDO
161 IF(ids == 0) THEN
162 CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1,c1="IGE3D",i1=id,i2=id,prmod=msg_cumu)
163 ENDIF
164 tabconpatch(nbpart_ig3d)%PID=ids
165 ELSE
166 i = i + 1
167 kxig3d(1,i) =ipart(1,ids)
168 kxig3d(2,i) =ipart(2,ids)
169 kxig3d(4,i) =iad
170 ipartig3d(i)=ids
171
172 READ(iin,rec=irec,err=999,fmt='(A)')line
173 READ(line,err=999,fmt=fmt_8i) id,idx1,idy1,idz1,nctrl,nrafx,nrafy,nrafz
174 nbig3d_patch = nbig3d_patch + 1
175 tabconpatch(nbpart_ig3d)%TAB_IG3D(nbig3d_patch)=i ! ID
176 nctrlmax = max(nctrlmax,nctrl)
177 kxig3d(3,i)=nctrl
178 kxig3d(5,i)=id
179 kxig3d(6,i)=idx1
180 kxig3d(7,i)=idy1
181 kxig3d(8,i)=idz1
182
183 kxig3d(12,i)=max(nrafx,1)
184 kxig3d(13,i)=max(nrafy,1)
185 kxig3d(14,i)=max(nrafz,1)
186 kxig3d(15,i)=inod_ige
187 inod_ige = inod_ige + 64
188C
189 nbline= ((nctrl-1)/10)+1
190
191 DO n=1,nbline
192 irec=irec+1
193 READ(iin,rec=irec,err=999,fmt='(A)')line
194 READ(line,err=999,fmt=fmt_10i) j10
195 DO j=1,10
196 IF(j10(j) /= 0)THEN
197 ixig3d(iad)=usr2sys(j10(j),itabm1,mess,id)
198 iad=iad+1
199 ENDIF
200 ENDDO
201 ENDDO
202 ENDIF
203 ENDDO
204C-----------
205 CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1,prmod=msg_print)
206C-------------------------------------
207C Recherche des ID doubles
208C-------------------------------------
209 DO i=1,numelig3d0
210 tabids(i)= kxig3d(5,i)
211 ENDDO
212 CALL udouble(tabids,1,numelig3d0,mess,0,bid)
213C-------------------------------------
214C Print
215C-------------------------------------
216 i1=1
217 i2=min0(50,numelig3d0)
218C
219 90 WRITE (iout,300)
220 DO 100 i=i1,i2
221 mid=ipm(1,kxig3d(1,i))
222 pid=igeo(1,kxig3d(2,i))
223 WRITE (iout,'(4(I10,1X))') i,kxig3d(5,i),mid,pid
224 WRITE (iout,'(10(I10,1X))')
225 . (itab(ixig3d(iad)),iad=kxig3d(4,i),kxig3d(4,i)+kxig3d(3,i)-1)
226 100 CONTINUE
227 IF(i2==numelig3d0)GOTO 200
228 i1=i1+50
229 i2=min0(i2+50,numelig3d0)
230 GOTO 90
231C
232 200 CONTINUE
233C
234 300 FORMAT(/' ISO-GEOMETRIC ELEMENTS'/
235 + ' ----------------------'/
236 + ' LOC-EL GLO-EL MATER GEOM'/
237 + ' NODES LIST')
238 RETURN
239C-------------------------------------
240 999 CALL freerr(3)
241 RETURN
242 END
my_real
#define my_real
Definition cppsort.cpp:32
lecig3d
subroutine lecig3d(itab, ipart, ipartig3d, ipm, igeo, kxig3d, ixig3d, itabm1, nctrlmax, tabconpatch)
Definition lecig3d.F:41
max
#define max(a, b)
Definition macros.h:21
meshsurfig3d_mod
Definition meshsurfig3d_mod.F:33
message_mod
Definition message_mod.F:1249
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
freerr
subroutine freerr(it)
Definition freform.F:506
fredec0
subroutine fredec0(id)
Definition freform.F:39
udouble
subroutine udouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:589
starter
program starter
Definition starter.F:39
meshsurfig3d_mod::tabconpatch_ig3d_
Definition meshsurfig3d_mod.F:83