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