OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_solid.F File Reference
#include "implicit_f.inc"
#include "analyse_name.inc"
#include "scr17_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "scr03_c.inc"
#include "sphcom.inc"
#include "titr_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_solid (ixs, pm, itab, itabm1, ipart, iparts, isolnod, ixs10, ixs20, ixs16, igeo, lsubmodel, is_dyna, x)
subroutine lce16s3 (ixs, isel, pm, ipoint, itab, itabm1, icode, iparts, igrbric, geo, isolnod, ixs10, ipart, ixs20, ixs16, knod2els, nod2els, igrsurf, sph2sol, sol2sph)
subroutine lce16s4 (ixs, pm, icode)
subroutine hm_prelce16s (ipart, igeo, ixs, nsphsol, lsubmodel, is_dyna)

Function/Subroutine Documentation

◆ hm_prelce16s()

subroutine hm_prelce16s ( integer, dimension(lipart1,*) ipart,
integer, dimension(npropgi,numgeo) igeo,
integer, dimension(nixs,*) ixs,
integer nsphsol,
type(submodel_data), dimension(nsubmod) lsubmodel,
integer, intent(in) is_dyna )

Definition at line 874 of file hm_read_solid.F.

875C-----------------------------------------------
876C M o d u l e s
877C-----------------------------------------------
878 USE message_mod
879 USE submodel_mod , ONLY : nsubmod, submodel_data
880 USE reader_old_mod , ONLY : line
881 USE user_id_mod , ONLY : id_limit
882 use element_mod , only : nixs
883C-----------------------------------------------
884C I m p l i c i t T y p e s
885C-----------------------------------------------
886#include "implicit_f.inc"
887C-----------------------------------------------
888C C o m m o n B l o c k s
889C-----------------------------------------------
890#include "scr17_c.inc"
891#include "com04_c.inc"
892#include "param_c.inc"
893C-----------------------------------------------
894C D u m m y A r g u m e n t s
895C-----------------------------------------------
896 INTEGER IPART(LIPART1,*), IGEO(NPROPGI,NUMGEO), IXS(NIXS,*), NSPHSOL
897 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
898 INTEGER,INTENT(IN)::IS_DYNA
899C-----------------------------------------------
900C L o c a l V a r i a b l e s
901C-----------------------------------------------
902 INTEGER I, J, IT, NT
903 INTEGER NSPHDIR,STAT
904 INTEGER FLAG_FMT,INDEX_PART
905 CHARACTER MESS*40
906 INTEGER, DIMENSION(:), ALLOCATABLE :: IPARTS
907 INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_SOL
908C-----------------------------------------------
909C E x t e r n a l F u n c t i o n s
910C-----------------------------------------------
911C
912 DATA mess/'3D SOLID ELEMENTS DEFINITION '/
913C=======================================================================
914 nsphsol=0
915C
916C--------------------------------------------------
917C ALLOCS & INITS
918C--------------------------------------------------
919 ALLOCATE (sub_sol(numels),stat=stat)
920 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
921 . msgtype=msgerror,
922 . c1='sub_sol')
923 SUB_SOL(1:NUMELS) = 0
924 INDEX_PART = 1
925C--------------------------------------------------
926C READING BRICKS INPUTS IN HM STRUCTURE
927C--------------------------------------------------
928 ALLOCATE(IPARTS(NUMELS))
929 CALL CPP_BRICK_READ(IXS,NIXS,IPARTS,SUB_SOL)
930C--------------------------------------------------
931C NSPHSOL NSPHDIR CALCULATION + CHECKS
932C--------------------------------------------------
933 DO I=1,NUMBRICK
934C--------------------------------------------------
935C INTERNAL PART ID
936C--------------------------------------------------
937 IF( IPART(4,INDEX_PART) /= IPARTS(I) )THEN
938 DO J=1,NPART
939 IF(IPART(4,J)== IPARTS(I) )INDEX_PART = J
940 ENDDO
941 ENDIF
942 IPARTS(I) = INDEX_PART
943C--------------------------------------------------
944 IF (IXS(11,I)>ID_LIMIT%GLOBAL) THEN
945 CALL ANCMSG(MSGID=509,ANMODE=ANINFO,MSGTYPE=MSGERROR,
946 . I1=IXS(11,I),C1=LINE,C2='/solid')
947 ENDIF
948C
949 IF (IPART(2,IPARTS(I)) > 0) THEN
950 NSPHDIR=IGEO(37,IPART(2,IPARTS(I)))
951 IF(IXS(6,I)+IXS(7,I)+IXS(8,I)+IXS(9,I)==0)THEN
952 NT=0
953 DO IT=1,NSPHDIR
954 NT=NT+IT
955 NSPHSOL=NSPHSOL+NT
956 END DO
957 ELSEIF(IXS(8,I)+IXS(9,I)==0)THEN
958 NT=0
959 DO IT=1,NSPHDIR
960 NT=NT+IT
961 END DO
962 NSPHSOL=NSPHSOL+NSPHDIR*NT
963 ELSE
964 NSPHSOL=NSPHSOL+NSPHDIR*NSPHDIR*NSPHDIR
965 ENDIF
966 ENDIF
967C
968 ENDDO
969C
970 FLAG_FMT = 0
971 I=0
972C--------------------------------------------------
973C READING TETRA4s INPUTS IN HM STRUCTURE
974C--------------------------------------------------
975 CALL CPP_TETRA4_READ(IXS,NIXS,NUMBRICK,IPARTS,SUB_SOL)
976C--------------------------------------------------
977C NSPHSOL NSPHDIR CALCULATION + CHECKS
978C--------------------------------------------------
979 DO I=NUMBRICK+1,NUMBRICK+NUMTETRA4
980C--------------------------------------------------
981C INTERNAL PART ID
982C--------------------------------------------------
983 IF( IPART(4,INDEX_PART) /= IPARTS(I) )THEN
984 DO J=1,NPART
985 IF(IPART(4,J)== IPARTS(I) )INDEX_PART = J
986 ENDDO
987 ENDIF
988 IPARTS(I) = INDEX_PART
989C--------------------------------------------------
990C
991 NSPHDIR=IGEO(37,IPART(2,IPARTS(I)))
992 IF (IXS(11,I)>ID_LIMIT%GLOBAL) THEN
993 CALL ANCMSG(MSGID=509,ANMODE=ANINFO,MSGTYPE=MSGERROR,
994 . I1=IXS(11,I),C1=LINE,C2='/solid')
995 ENDIF
996 NT=0
997 DO IT=1,NSPHDIR
998 NT=NT+IT
999 NSPHSOL=NSPHSOL+NT
1000 END DO
1001 ENDDO
1002C--------------------------------------------------
1003C READING PENTA6s INPUTS IN HM STRUCTURE
1004C--------------------------------------------------
1005 IF (IS_DYNA ==0) CALL CPP_PENTA6_READ(IXS,NIXS,NUMBRICK+NUMTETRA4,IPARTS,SUB_SOL)
1006C--------------------------------------------------
1007C NSPHSOL NSPHDIR CALCULATION + CHECKS
1008C--------------------------------------------------
1009 DO I=NUMBRICK+NUMTETRA4+1,NUMBRICK+NUMTETRA4+NUMPENTA6
1010C--------------------------------------------------
1011C INTERNAL PART ID
1012C--------------------------------------------------
1013 IF( IPART(4,INDEX_PART) /= IPARTS(I) )THEN
1014 DO J=1,NPART
1015 IF(IPART(4,J)== IPARTS(I) )INDEX_PART = J
1016 ENDDO
1017 ENDIF
1018 IPARTS(I) = INDEX_PART
1019C--------------------------------------------------
1020 NSPHDIR=IGEO(37,IPARTS(I-NUMBRICK))
1021 IF (IXS(11,I)>ID_LIMIT%GLOBAL) THEN
1022 CALL ANCMSG(MSGID=509,ANMODE=ANINFO,MSGTYPE=MSGERROR,
1023 . I1=IXS(11,I),C1=LINE,C2='/solid')
1024 ENDIF
1025 NT=0
1026 DO IT=1,NSPHDIR
1027 NT=NT+IT
1028 NSPHSOL=NSPHSOL+NT
1029 END DO
1030 ENDDO
1031 IF (ALLOCATED(IPARTS)) DEALLOCATE(IPARTS)
1032 IF (ALLOCATED(SUB_SOL)) DEALLOCATE(SUB_SOL)
1033C--------------------------
1034 RETURN
message_mod
Definition message_mod.F:1257
submodel_mod
Definition submodel_mod.F:717
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725
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
submodel_mod::submodel_data
Definition submodel_mod.F:728

◆ hm_read_solid()

subroutine hm_read_solid ( integer, dimension(nixs,*), intent(out) ixs,
dimension(npropm,*), intent(in) pm,
integer, dimension(*), intent(in) itab,
integer, dimension(*), intent(in) itabm1,
integer, dimension(lipart1,*), intent(in) ipart,
integer, dimension(*), intent(out) iparts,
integer, dimension(*), intent(out) isolnod,
integer, dimension(6,*), intent(out) ixs10,
integer, dimension(12,*), intent(out) ixs20,
integer, dimension(8,*), intent(out) ixs16,
integer, dimension(npropgi,*), intent(in) igeo,
type(submodel_data), dimension(*), intent(in) lsubmodel,
integer, intent(in) is_dyna,
intent(in) x )

Definition at line 39 of file hm_read_solid.F.

42C-----------------------------------------------
43C ROUTINE DESCRIPTION :
44C ===================
45C READ /BRICK /TETRA4 /PENTA6 /TETRA10 /BRICK20 ELEMENTS USING HM_READER
46C-----------------------------------------------
47C DUMMY ARGUMENTS DESCRIPTION:
48C ===================
49C
50C NAME DESCRIPTION
51C
52C IXS SOLID ELEM ARRAY : CONNECTIVITY, ID, PID, MID
53C PM MATERIAL ARRAY (REAL)
54C ITAB USER ID OF NODES
55C ITABM1 REVERSE TAB ITAB
56C IPART PART ARRAY
57C IPARTS INTERNAL PART ID OF A GIVEN SOLID ELEMENT
58C ISOLNOD NUMBER OF NODES OF SOLID ELEMENT
59C IXS10 TETRA10 CONNECTIVITY NODES 5->10
60C IXS20 BRICK20 CONNECTIVITY NODES 9->20
61C IXS16 BRICK16 CONNECTIVITY NODES 9->16
62C IGEO PROP ARRAY (INTEGER)
63C LSUBMODEL SUBMODEL STRUCTURE
64C-----------------------------------------------
65C M o d u l e s
66C-----------------------------------------------
67 USE message_mod
68 USE submodel_mod
69 use element_mod , only : nixs
70C-----------------------------------------------
71C I m p l i c i t T y p e s
72C-----------------------------------------------
73#include "implicit_f.inc"
74C-----------------------------------------------
75C A n a l y s e M o d u l e
76C-----------------------------------------------
77#include "analyse_name.inc"
78C-----------------------------------------------
79C C o m m o n B l o c k s
80C-----------------------------------------------
81#include "scr17_c.inc"
82#include "com04_c.inc"
83#include "param_c.inc"
84C-----------------------------------------------
85C D u m m y A r g u m e n t s
86C-----------------------------------------------
87C INPUT ARGUMENTS
88 INTEGER,INTENT(IN)::ITAB(*)
89 INTEGER,INTENT(IN)::ITABM1(*)
90 INTEGER,INTENT(IN)::IPART(LIPART1,*)
91 INTEGER,INTENT(IN)::IGEO(NPROPGI,*)
92 INTEGER,INTENT(IN)::IS_DYNA
93 my_real,INTENT(IN)::pm(npropm,*)
94 my_real, DIMENSION(3,NUMNOD), INTENT(IN):: x
95 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
96C OUTPUT ARGUMENTS
97 INTEGER,INTENT(OUT)::ISOLNOD(*)
98 INTEGER,INTENT(OUT)::IXS(NIXS,*)
99 INTEGER,INTENT(OUT)::IXS10(6,*)
100 INTEGER,INTENT(OUT)::IXS16(8,*)
101 INTEGER,INTENT(OUT)::IXS20(12,*)
102 INTEGER,INTENT(OUT)::IPARTS(*)
103C-----------------------------------------------
104C L o c a l V a r i a b l e s
105C-----------------------------------------------
106 INTEGER I, J, MT, I10,I20,I16
107 INTEGER IC1,IC2,IC3,IC4,IPID,N,STAT
108 INTEGER INDEX_PART,IXS10_SAV(6),IC5,IC6,
109 . IC7,IC8
110 my_real bid
111 CHARACTER MESS*40, MESS2*40
112 INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_SOL
113C-----------------------------------------------
114C E x t e r n a l F u n c t i o n s
115C-----------------------------------------------
116 my_real
117 . checkvolume_4n,checkvolume_6n,checkvolume_8n
118C-----------------------------------------------
119C E x t e r n a l F u n c t i o n s
120C-----------------------------------------------
121 INTEGER USR2SYS
122C
123 DATA mess/'3D SOLID ELEMENTS DEFINITION '/
124 DATA mess2/'3D SOLID ELEMENTS SELECTION FOR TH PLOT '/
125C=======================================================================
126C--------------------------------------------------
127C ALLOCS & INITS
128C--------------------------------------------------
129 ALLOCATE (sub_sol(numels),stat=stat)
130 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
131 . msgtype=msgerror,
132 . c1='SUB_SOL')
133 sub_sol(1:numels) = 0
134 index_part = 1
135C--------------------------------------------------
136C READING BRICK INPUTS IN HM STRUCTURE
137C--------------------------------------------------
138 CALL cpp_brick_read(ixs,nixs,iparts,sub_sol)
139C--------------------------------------------------
140C FILL OTHER STRUCTURES + CHECKS
141C--------------------------------------------------
142 i = 0
143 DO n=1,numbrick
144 i = i + 1
145 IF(ixs(6,i)+ixs(7,i)+ixs(8,i)+ixs(9,i)==0)THEN
146 DO j=2,5
147 ixs(j,i)=usr2sys(ixs(j,i),itabm1,mess,ixs(11,i))
148 CALL anodset(ixs(j,i), check_volu)
149 ENDDO
150 ixs(9,i)=ixs(5,i)
151 ixs(8,i)=ixs(4,i)
152 ixs(7,i)=ixs(4,i)
153 ixs(6,i)=ixs(5,i)
154 ixs(5,i)=ixs(3,i)
155 ixs(4,i)=ixs(3,i)
156 ixs(3,i)=ixs(2,i)
157 isolnod(i)=4
158 IF (checkvolume_4n(x ,ixs(1,i)) < zero) THEN
159 ic2=ixs(6,i)
160 ic4=ixs(4,i)
161 ixs(4,i)=ic2
162 ixs(6,i)=ic4
163 ixs(5,i)=ic2
164 ixs(9,i)=ic4
165 END IF
166 ELSEIF(ixs(8,i)+ixs(9,i)==0)THEN
167 DO j=2,7
168 ixs(j,i)=usr2sys(ixs(j,i),itabm1,mess,ixs(11,i))
169 CALL anodset(ixs(j,i), check_volu)
170 ENDDO
171 ixs(9,i)=ixs(5,i)
172 ixs(8,i)=ixs(7,i)
173 ixs(7,i)=ixs(6,i)
174 ixs(6,i)=ixs(5,i)
175 ixs(5,i)=ixs(2,i)
176 isolnod(i)=6
177 IF (checkvolume_6n(x ,ixs(1,i)) < zero) THEN
178C renumber connectivity
179 ic1 = ixs(6,i)
180 ic2 = ixs(7,i)
181 ic3 = ixs(8,i)
182 ic4 = ixs(2,i)
183 ic5 = ixs(3,i)
184 ic6 = ixs(4,i)
185 ixs(2,i) = ic1
186 ixs(3,i) = ic2
187 ixs(4,i) = ic3
188 ixs(6,i) = ic4
189 ixs(7,i) = ic5
190 ixs(8,i) = ic6
191 ENDIF
192 ELSE
193 DO j=2,9
194 ixs(j,i)=usr2sys(ixs(j,i),itabm1,mess,ixs(11,i))
195 CALL anodset(ixs(j,i), check_volu)
196 ENDDO
197 isolnod(i)=8
198 IF (checkvolume_8n(x ,ixs(1,i)) < zero) THEN
199C renumber connectivity
200 ic1 = ixs(6,i)
201 ic2 = ixs(7,i)
202 ic3 = ixs(8,i)
203 ic4 = ixs(9,i)
204 ic5 = ixs(2,i)
205 ic6 = ixs(3,i)
206 ic7 = ixs(4,i)
207 ic8 = ixs(5,i)
208 ixs(2,i) = ic1
209 ixs(3,i) = ic2
210 ixs(4,i) = ic3
211 ixs(5,i) = ic4
212 ixs(6,i) = ic5
213 ixs(7,i) = ic6
214 ixs(8,i) = ic7
215 ixs(9,i) = ic8
216 ENDIF
217 ENDIF
218C--------------------------------------------------
219C INTERNAL PART ID
220C--------------------------------------------------
221 IF( ipart(4,index_part) /= iparts(i) )THEN
222 DO j=1,npart
223 IF(ipart(4,j)== iparts(i) ) index_part = j
224 ENDDO
225 ENDIF
226 IF( ipart(4,index_part) /= iparts(i) ) THEN
227 CALL ancmsg(msgid=402,
228 . msgtype=msgerror,
229 . anmode=aninfo_blind_1,
230 . c1="BRICK",
231 . i1=iparts(i),
232 . i2=iparts(i),
233 . prmod=msg_cumu)
234 ENDIF
235 iparts(i) = index_part
236 mt=ipart(1,index_part)
237 ipid=ipart(2,index_part)
238 ixs(1,i)=mt
239 ixs(10,i)=ipid
240 ENDDO
241C--------------------------------------------------
242C READING TETRA4 INPUTS IN HM STRUCTURE
243C--------------------------------------------------
244 CALL cpp_tetra4_read(ixs,nixs,numbrick,iparts,sub_sol)
245C--------------------------------------------------
246C FILL OTHER STRUCTURES + CHECKS
247C--------------------------------------------------
248 index_part = 1
249 DO n=1,numtetra4
250 i = i + 1
251C--------------------------------------------------
252C INTERNAL PART ID
253C--------------------------------------------------
254 IF( ipart(4,index_part) /= iparts(i) )THEN
255 DO j=1,npart
256 IF(ipart(4,j)== iparts(i) ) index_part = j
257 ENDDO
258 ENDIF
259 IF( ipart(4,index_part) /= iparts(i) ) THEN
260 CALL ancmsg(msgid=402,
261 . msgtype=msgerror,
262 . anmode=aninfo_blind_1,
263 . c1="TETRA4",
264 . i1=iparts(i),
265 . i2=iparts(i),
266 . prmod=msg_cumu)
267 ENDIF
268 iparts(i) = index_part
269C--------------------------------------------------
270 mt=ipart(1,index_part)
271 ipid=ipart(2,index_part)
272 ixs(1,i)=mt
273 ixs(10,i)=ipid
274 DO j=2,5
275 ixs(j,i)=usr2sys(ixs(j,i),itabm1,mess,ixs(11,i))
276 CALL anodset(ixs(j,i), check_volu)
277 ENDDO
278 ixs(9,i)=ixs(5,i)
279 ixs(8,i)=ixs(4,i)
280 ixs(7,i)=ixs(4,i)
281 ixs(6,i)=ixs(5,i)
282 ixs(5,i)=ixs(3,i)
283 ixs(4,i)=ixs(3,i)
284 ixs(3,i)=ixs(2,i)
285 isolnod(i)=4
286 IF (checkvolume_4n(x ,ixs(1,i)) < zero) THEN
287 ic2=ixs(6,i)
288 ic4=ixs(4,i)
289 ixs(4,i)=ic2
290 ixs(6,i)=ic4
291 ixs(5,i)=ic2
292 ixs(9,i)=ic4
293 END IF
294 ENDDO
295C--------------------------------------------------
296C READING PENTA6 INPUTS IN HM STRUCTURE
297C--------------------------------------------------
298 IF (is_dyna ==0) CALL cpp_penta6_read(ixs,nixs,numbrick+numtetra4,iparts,sub_sol)
299C--------------------------------------------------
300C FILL OTHER STRUCTURES + CHECKS
301C--------------------------------------------------
302 index_part = 1
303 DO n=1,numpenta6
304 i = i + 1
305C--------------------------------------------------
306C INTERNAL PART ID
307C--------------------------------------------------
308 IF( ipart(4,index_part) /= iparts(i) )THEN
309 DO j=1,npart
310 IF(ipart(4,j)== iparts(i) ) index_part = j
311 ENDDO
312 ENDIF
313 IF( ipart(4,index_part) /= iparts(i) ) THEN
314 CALL ancmsg(msgid=402,
315 . msgtype=msgerror,
316 . anmode=aninfo_blind_1,
317 . c1="PENTA6",
318 . i1=iparts(i),
319 . i2=iparts(i),
320 . prmod=msg_cumu)
321 ENDIF
322 iparts(i) = index_part
323C--------------------------------------------------
324 mt=ipart(1,index_part)
325 ipid=ipart(2,index_part)
326 ixs(1,i)=mt
327 ixs(10,i)=ipid
328 DO j=2,7
329 ixs(j,i)=usr2sys(ixs(j,i),itabm1,mess,ixs(11,i))
330 CALL anodset(ixs(j,i), check_volu)
331 ENDDO
332 ixs(9,i)=ixs(5,i)
333 ixs(8,i)=ixs(7,i)
334 ixs(7,i)=ixs(6,i)
335 ixs(6,i)=ixs(5,i)
336 ixs(5,i)=ixs(2,i)
337 isolnod(i)=6
338 ENDDO
339C--------------------------------------------------
340C READING TETRA10 INPUTS IN HM STRUCTURE
341C--------------------------------------------------
342 CALL cpp_tetra10_read(ixs,nixs,ixs10,6,numbrick+numtetra4+numpenta6,iparts,sub_sol)
343C--------------------------------------------------
344C FILL OTHER STRUCTURES + CHECKS
345C--------------------------------------------------
346 index_part = 1
347 i10=0
348 DO n=1,numels10
349 i = i + 1
350 i10 = i10 + 1
351C--------------------------------------------------
352C INTERNAL PART ID
353C--------------------------------------------------
354 IF( ipart(4,index_part) /= iparts(i) )THEN
355 DO j=1,npart
356 IF(ipart(4,j)== iparts(i) ) index_part = j
357 ENDDO
358 ENDIF
359 IF( ipart(4,index_part) /= iparts(i) ) THEN
360 CALL ancmsg(msgid=402,
361 . msgtype=msgerror,
362 . anmode=aninfo_blind_1,
363 . c1="TETRA10",
364 . i1=iparts(i),
365 . i2=iparts(i),
366 . prmod=msg_cumu)
367 ENDIF
368 iparts(i) = index_part
369C--------------------------------------------------
370 mt=ipart(1,index_part)
371 ipid=ipart(2,index_part)
372 ixs(1,i)=mt
373 ixs(10,i)=ipid
374 DO j=2,5
375 ixs(j,i)=usr2sys(ixs(j,i),itabm1,mess,ixs(11,i))
376 CALL anodset(ixs(j,i), check_volu)
377 ENDDO
378C
379 DO j=1,6
380 IF(ixs10(j,i10)/=0)THEN
381 ixs10(j,i10)=usr2sys(ixs10(j,i10),itabm1,mess,ixs(11,i))
382 CALL anodset(ixs10(j,i10), check_volu)
383 ENDIF
384 ENDDO
385C
386 ixs(9,i)=ixs(5,i)
387 ixs(8,i)=ixs(4,i)
388 ixs(7,i)=ixs(4,i)
389 ixs(6,i)=ixs(5,i)
390 ixs(5,i)=ixs(3,i)
391 ixs(4,i)=ixs(3,i)
392 ixs(3,i)=ixs(2,i)
393 isolnod(i)=10
394 IF (checkvolume_4n(x ,ixs(1,i)) < zero) THEN
395 ic2=ixs(6,i)
396 ic4=ixs(4,i)
397 ixs10_sav(1:6) = ixs10(1:6,i10)
398 ixs(4,i)=ic2
399 ixs(6,i)=ic4
400 ixs(5,i)=ic2
401 ixs(9,i)=ic4
402 ixs10(1,i10) = ixs10_sav(4)
403 ixs10(2,i10) = ixs10_sav(6)
404 ixs10(4,i10) = ixs10_sav(1)
405 ixs10(6,i10) = ixs10_sav(2)
406 END IF
407 ENDDO
408C--------------------------------------------------
409C READING BRIC20 INPUTS IN HM STRUCTURE
410C--------------------------------------------------
411 IF (is_dyna ==0) CALL cpp_brick20_read(ixs,nixs,ixs20,12,numbrick+numtetra4+numpenta6+numels10,iparts,sub_sol)
412C--------------------------------------------------
413C FILL OTHER STRUCTURES + CHECKS
414C--------------------------------------------------
415 index_part = 1
416 i20=0
417 DO n=1,numels20
418 i = i + 1
419 i20 = i20 + 1
420C--------------------------------------------------
421C INTERNAL PART ID
422C--------------------------------------------------
423 IF( ipart(4,index_part) /= iparts(i) )THEN
424 DO j=1,npart
425 IF(ipart(4,j)== iparts(i) ) index_part = j
426 ENDDO
427 ENDIF
428 IF( ipart(4,index_part) /= iparts(i) ) THEN
429 CALL ancmsg(msgid=402,
430 . msgtype=msgerror,
431 . anmode=aninfo_blind_1,
432 . c1="BRIC20",
433 . i1=iparts(i),
434 . i2=iparts(i),
435 . prmod=msg_cumu)
436 ENDIF
437 iparts(i) = index_part
438C--------------------------------------------------
439 mt=ipart(1,index_part)
440 ipid=ipart(2,index_part)
441 ixs(1,i)=mt
442 ixs(10,i)=ipid
443 DO j=2,9
444 ixs(j,i)=usr2sys(ixs(j,i),itabm1,mess,ixs(11,i))
445 CALL anodset(ixs(j,i), check_volu)
446 ENDDO
447C
448 DO j=1,12
449 IF(ixs20(j,i20)/=0)THEN
450 ixs20(j,i20)=usr2sys(ixs20(j,i20),itabm1,mess,ixs(11,i))
451 CALL anodset(ixs20(j,i20), check_volu)
452 ENDIF
453 ENDDO
454 isolnod(i)=20
455 ENDDO
456C--------------------------------------------------
457C READING SHEL16 INPUTS IN HM STRUCTURE
458C--------------------------------------------------
459 IF (is_dyna ==0) CALL cpp_shel16_read(ixs,nixs,ixs16,8,numbrick+numtetra4+numpenta6+numels10+numels20,iparts,sub_sol)
460C--------------------------------------------------
461C FILL OTHER STRUCTURES + CHECKS
462C--------------------------------------------------
463 index_part = 1
464 i16=0
465 DO n=1,numels16
466 i = i + 1
467 i16 = i16 + 1
468C--------------------------------------------------
469C INTERNAL PART ID
470C--------------------------------------------------
471 IF( ipart(4,index_part) /= iparts(i) )THEN
472 DO j=1,npart
473 IF(ipart(4,j)== iparts(i) ) index_part = j
474 ENDDO
475 ENDIF
476 IF( ipart(4,index_part) /= iparts(i) ) THEN
477 CALL ancmsg(msgid=402,
478 . msgtype=msgerror,
479 . anmode=aninfo_blind_1,
480 . c1="SHEL16",
481 . i1=iparts(i),
482 . i2=iparts(i),
483 . prmod=msg_cumu)
484 ENDIF
485 iparts(i) = index_part
486C--------------------------------------------------
487 mt=ipart(1,index_part)
488 ipid=ipart(2,index_part)
489 ixs(1,i)=mt
490 ixs(10,i)=ipid
491 DO j=2,9
492 ixs(j,i)=usr2sys(ixs(j,i),itabm1,mess,ixs(11,i))
493 CALL anodset(ixs(j,i), check_volu)
494 ENDDO
495C
496 DO j=1,8
497 IF(ixs16(j,i16)/=0)THEN
498 ixs16(j,i16)=usr2sys(ixs16(j,i16),itabm1,mess,ixs(11,i))
499 CALL anodset(ixs16(j,i16), check_volu)
500 ENDIF
501 ENDDO
502 isolnod(i)=16
503 ENDDO
504C-----------
505 CALL ancmsg(msgid=402,
506 . msgtype=msgerror,
507 . anmode=aninfo_blind_1,
508 . prmod=msg_print)
509C-------------------------------------
510 IF (ALLOCATED(sub_sol)) DEALLOCATE(sub_sol)
511C-------------------------------------
512C Search for double IDs
513C-------------------------------------
514 CALL udouble(ixs(nixs,1),nixs,numels,mess,0,bid)
515 RETURN
anodset
void anodset(int *id, int *type)
Definition analyse_node.c:321
checkvolume_6n
function checkvolume_6n(x, ixs)
Definition checksvolume.F:132
checkvolume_8n
function checkvolume_8n(x, ixs)
Definition checksvolume.F:39
checkvolume_4n
function checkvolume_4n(x, ixs)
Definition checksvolume.F:217
my_real
#define my_real
Definition cppsort.cpp:32
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:146
udouble
subroutine udouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:573

◆ lce16s3()

subroutine lce16s3 ( integer, dimension(nixs,*) ixs,
integer, dimension(*) isel,
pm,
integer, dimension(2,*) ipoint,
integer, dimension(*) itab,
integer, dimension(*) itabm1,
integer, dimension(*) icode,
integer, dimension(*) iparts,
type (group_), dimension(ngrbric) igrbric,
geo,
integer, dimension(*) isolnod,
integer, dimension(6,*) ixs10,
integer, dimension(lipart1,*) ipart,
integer, dimension(12,*) ixs20,
integer, dimension(8,*) ixs16,
integer, dimension(*) knod2els,
integer, dimension(*) nod2els,
type (surf_), dimension(nsurf) igrsurf,
integer, dimension(*) sph2sol,
integer, dimension(2,*) sol2sph )

Definition at line 526 of file hm_read_solid.F.

530C-----------------------------------------------
531C M o d u l e s
532C-----------------------------------------------
533 USE groupdef_mod
534 use element_mod , only : nixs
535C-----------------------------------------------
536C I m p l i c i t T y p e s
537C-----------------------------------------------
538#include "implicit_f.inc"
539C-----------------------------------------------
540C C o m m o n B l o c k s
541C-----------------------------------------------
542#include "com04_c.inc"
543#include "units_c.inc"
544#include "scr03_c.inc"
545#include "sphcom.inc"
546#include "param_c.inc"
547#include "titr_c.inc"
548#include "scr17_c.inc"
549C-----------------------------------------------
550C D u m m y A r g u m e n t s
551C-----------------------------------------------
552 INTEGER IXS(NIXS,*), ISEL(*), IPOINT(2,*), ITAB(*), ITABM1(*),
553 . ICODE(*),IPARTS(*),ISOLNOD(*),
554 . IXS10(6,*),IPART(LIPART1,*),IXS20(12,*),IXS16(8,*),
555 . KNOD2ELS(*),NOD2ELS(*),SPH2SOL(*),SOL2SPH(2,*)
556 my_real pm(npropm,nummat),geo(npropg,*)
557C-----------------------------------------------
558 TYPE (GROUP_) ,DIMENSION(NGRBRIC) :: IGRBRIC
559 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
560C-----------------------------------------------
561C L o c a l V a r i a b l e s
562C-----------------------------------------------
563 INTEGER I, J, MT, MLAW, JTUR, I1, I2, INEW, K, N, NN
564 INTEGER IC,IC1,IC2,IC3,IC4
565 CHARACTER MESS*40, MESS2*40
566C-----------------------------------------------
567C E x t e r n a l F u n c t i o n s
568C-----------------------------------------------
569C
570 DATA mess/'3D SOLID ELEMENTS DEFINITION '/
571 DATA mess2/'3D SOLID ELEMENTS SELECTION FOR TH PLOT '/
572C
573C----------------------------------------------------
574C DETECTION DES ELEMENTS LOIS 6 PAROI---->LOI 17
575C----------------------------------------------------
576C LAW 17 IF THE BCS IS 111 (3D)
577 DO i=1,numels8
578 mt=ixs(1,i)
579 mlaw=nint(pm(19,mt))
580 jtur=nint(pm(70,mt))
581 DO j=2,9
582 IF((mlaw==6.AND.jtur/=0) .OR. mlaw==46) THEN
583 ic=icode(ixs(j,i))
584 ic1=ic/512
585 ic2=(ic-512*ic1)/64
586 ic3=(ic-512*ic1-64*ic2)/8
587 ic4=(ic-512*ic1-64*ic2-8*ic3)
588 IF(ic1==7 .OR. ic4==7)ixs(1,i)=-iabs(ixs(1,i))
589 ENDIF
590 ENDDO
591 ENDDO
592C----------------------------------------------------
593C CLASSIFICATION OF ELEMENTS BY MATERIAL LAW
594C----------------------------------------------------
595 CALL reordr(ixs ,nixs ,numels8,pm ,ipoint ,
596 . iparts,ngrbric,igrbric,nummat)
597C------------------------------------------
598C RENAMING FOR SURFACES
599C------------------------------------------
600 DO i=1,nsurf
601 nn =igrsurf(i)%NSEG
602 DO j=1,nn
603 IF (igrsurf(i)%ELTYP(j) == 1) THEN
604 IF (igrsurf(i)%ELEM(j) <= numels8)
605 . igrsurf(i)%ELEM(j)=ipoint(1,igrsurf(i)%ELEM(j))
606 END IF
607 ENDDO
608 ENDDO
609C------------------------------------------
610C RENAMING OF SPH PARTICLES
611C------------------------------------------
612 IF(nsphsol/=0)THEN
613 DO i=1,numsph
614 IF(sph2sol(i)/=0)sph2sol(i)=ipoint(1,sph2sol(i))
615 ENDDO
616C
617C Rebuild SOL2SPH, SOL2SPH(1,N)+1<=I<=SOLSPH(2,N) <=> N==SPH2SOL(I)
618 DO n=1,numels8
619 sol2sph(1,n)=0
620 sol2sph(2,n)=0
621 END DO
622 n=sph2sol(first_sphsol)
623 sol2sph(1,n)=0
624 sol2sph(2,n)=sol2sph(1,n)+1
625 DO i=first_sphsol+1,first_sphsol+nsphsol-1
626 IF(sph2sol(i)==n)THEN
627 sol2sph(2,n)=sol2sph(2,n)+1
628 ELSE
629 n=sph2sol(i)
630 sol2sph(1,n)=i-1
631 sol2sph(2,n)=sol2sph(1,n)+1
632 END IF
633 END DO
634 END IF
635C------------------------------------------
636C PERMUTATION OF ISOLNOD
637C------------------------------------------
638 DO i=1,numels8
639 ipoint(2,i)=isolnod(i)
640 ENDDO
641 DO i=1,numels8
642 isolnod(ipoint(1,i))=ipoint(2,i)
643 ENDDO
644C------------------------------------------
645C Reconstruction of the matrix Nod -> Solid elt
646C------------------------------------------
647 DO k=2,9
648 DO i=1,numels
649 n = ixs(k,i)
650 knod2els(n) = knod2els(n) + 1
651 IF(n/=0) nod2els(knod2els(n)) = i
652 END DO
653 END DO
654C
655 DO k=1,6
656 DO i=1,numels10
657 n = ixs10(k,i)
658 IF (n/=0) THEN
659 knod2els(n) = knod2els(n) + 1
660 nod2els(knod2els(n)) = numels8+i
661 END IF
662 END DO
663 END DO
664C
665 DO k=1,12
666 DO i=1,numels20
667 n = ixs20(k,i)
668 IF (n/=0) THEN
669 knod2els(n) = knod2els(n) + 1
670 nod2els(knod2els(n)) = numels10+numels8+i
671 END IF
672 END DO
673 END DO
674C
675 DO k=1,8
676 DO i=1,numels16
677 n = ixs16(k,i)
678 IF (n/=0) THEN
679 knod2els(n) = knod2els(n) + 1
680 nod2els(knod2els(n)) = numels20+numels10+numels8+i
681 END IF
682 END DO
683 END DO
684C
685 DO n=numnod,1,-1
686 knod2els(n+1)=knod2els(n)
687 END DO
688 knod2els(1)=0
689C------------------------------------------
690C PRINT
691C------------------------------------------
692 i1=1
693 i2=50
694C
695 IF(ipri>=5)THEN
696 WRITE (iout,'(//A//)') titre(206)
697 90 CONTINUE
698 i2=min0(i2,numels8)
699 WRITE (iout,'(//A/A//A/A,A/)')
700 . titre(90),titre(91),
701 . ' ELEMENT INTERNAL PART MATER PRSET',
702 . ' node1 node2 node3 node4 node5',
703 . ' node6 node7 node8'
704 DO I=I1,I2
705 INEW=IPOINT(1,I)
706 WRITE (IOUT,'(5i10)')
707 . IXS(11,INEW),INEW,IPART(4,IPARTS(INEW)),
708 . IPART(5,IPARTS(INEW)),IPART(6,IPARTS(INEW))
709 IF(ISOLNOD(INEW)==4)THEN
710 WRITE (IOUT,'(8i10)')
711 . ITAB(IXS(2,INEW)),ITAB(IXS(4,INEW)),
712 . ITAB(IXS(7,INEW)),ITAB(IXS(6,INEW))
713 ELSEIF(ISOLNOD(INEW)==6)THEN
714 WRITE (IOUT,'(6i10)')
715 . ITAB(IXS(5,INEW)),ITAB(IXS(3,INEW)),ITAB(IXS(4,INEW)),
716 . ITAB(IXS(6,INEW)),ITAB(IXS(7,INEW)),ITAB(IXS(8,INEW))
717 ELSE
718 WRITE (IOUT,'(8i10)')
719 . (ITAB(IXS(J,INEW)),J=2,9)
720 ENDIF
721 ENDDO
722 IF(I2==NUMELS8)GOTO 200
723 I1=I1+50
724 I2=I2+50
725 GOTO 90
726C
727 200 CONTINUE
728 I1=1
729 I2=50
730C
731 290 CONTINUE
732 WRITE (IOUT,'(//a/a//a/a,a/)')
733 . ' ten node tetra elements',
734 . ' -----------------------',
735 . ' element internal part mater prset',
736 . ' node1 node2 node3 node4 node5',
737 . ' node6 node7 node8 node9 node10'
738 I2=MIN0(I2,NUMELS10)
739 DO I=I1,I2
740 INEW=I+NUMELS8
741 WRITE (IOUT,'(5i10)')
742 . IXS(11,INEW),INEW,IPART(4,IPARTS(INEW)),
743 . IPART(5,IPARTS(INEW)),IPART(6,IPARTS(INEW))
744 WRITE (IOUT,'(10i10)')
745 . ITAB(IXS(2,INEW)),ITAB(IXS(4,INEW)),
746 . ITAB(IXS(7,INEW)),ITAB(IXS(6,INEW)),
747 . (ITAB(IXS10(J,I)),J=1,6)
748 ENDDO
749 IF(I2==NUMELS10)GOTO 300
750 I1=I1+50
751 I2=I2+50
752 GOTO 290
753C
754 300 CONTINUE
755 I1=1
756 I2=50
757C
758 DOWHILE(I1<=NUMELS20)
759 WRITE (IOUT,'(//a/a//a/a,a/a/a)')
760 . ' twenty node brick elements',
761 . ' --------------------------',
762 . ' element internal part mater prset',
763 . ' node1 node2 node3 node4 node5',
764 . ' node6 node7 node8',
765 . ' node9 node10 node11 node12 node13 node14',
766 . ' node15 node16 node17 node18 node19 node20'
767 I2=MIN0(I2,NUMELS20)
768 DO I=I1,I2
769 INEW=I+NUMELS8+NUMELS10
770 WRITE (IOUT,'(5i10)')
771 . IXS(11,INEW),INEW,IPART(4,IPARTS(INEW)),
772 . IPART(5,IPARTS(INEW)),IPART(6,IPARTS(INEW))
773 WRITE (IOUT,'(8i10/6i10/6i10)')
774 . (ITAB(IXS(J,INEW)),J=2,9),
775 . (ITAB(IXS20(J,I)),J=1,12)
776 ENDDO
777 I1=I1+50
778 I2=I2+50
779 ENDDO
780 I1=1
781 I2=50
782C
783 DOWHILE(I1<=NUMELS16)
784 WRITE (IOUT,'(//a/a//a/a,a/a,a)')
785 . ' sixteen node shell elements',
786 . ' ---------------------------',
787 . ' element internal part mater prset',
788 . ' node1 node2 node3 node4 node5',
789 . ' node6 node7 node8',
790 . ' node9 node10 node11 node12 node13 node14',
791 . ' node15 node16'
792 I2=MIN0(I2,NUMELS16)
793 DO I=I1,I2
794 INEW=I+NUMELS8+NUMELS10+NUMELS20
795 WRITE (IOUT,'(5i10)')
796 . IXS(11,INEW),INEW,IPART(4,IPARTS(INEW)),
797 . IPART(5,IPARTS(INEW)),IPART(6,IPARTS(INEW))
798 WRITE (IOUT,'(8i10/8i10)')
799 . (ITAB(IXS(J,INEW)),J=2,9),
800 . (ITAB(IXS16(J,I)),J=1,8)
801 ENDDO
802 I1=I1+50
803 I2=I2+50
804 ENDDO
805 ENDIF
806C
807 RETURN
groupdef_mod
Definition groupdef_mod.F:668
reordr
subroutine reordr(ix, nx, nel, pm, ipoint, iparts, ngrele, igrelem, nummat)
Definition reordr.F:31

◆ lce16s4()

subroutine lce16s4 ( integer, dimension(nixs,*) ixs,
pm,
integer, dimension(*) icode )

Definition at line 815 of file hm_read_solid.F.

816 use element_mod , only : nixs
817C
818C-----------------------------------------------
819C I m p l i c i t T y p e s
820C-----------------------------------------------
821#include "implicit_f.inc"
822C-----------------------------------------------
823C C o m m o n B l o c k s
824C-----------------------------------------------
825#include "com04_c.inc"
826#include "param_c.inc"
827C-----------------------------------------------
828C D u m m y A r g u m e n t s
829C-----------------------------------------------
830 INTEGER IXS(NIXS,*), ICODE(*)
831C REAL
832 my_real
833 . pm(npropm,*)
834C-----------------------------------------------
835C L o c a l V a r i a b l e s
836C-----------------------------------------------
837 INTEGER I, J, MT, MLAW, JTUR
838 INTEGER IC,IC1,IC2,IC3,IC4
839C-----------------------------------------------
840C DETECTION DES ELEMENTS LOIS 6 PAROI---->LOI 17
841C----------------------------------------------------
842C LAW 17 IF THE BCS IS 111 (3D)
843 DO i=1,numels8
844 mt=ixs(1,i)
845 IF(mt < 1)cycle
846 mlaw=nint(pm(19,mt))
847 jtur=nint(pm(70,mt))
848 DO j=2,9
849 IF((mlaw==6.AND.jtur/=0) .OR. mlaw==46) THEN
850 ic=icode(ixs(j,i))
851 ic1=ic/512
852 ic2=(ic-512*ic1)/64
853 ic3=(ic-512*ic1-64*ic2)/8
854 ic4=(ic-512*ic1-64*ic2-8*ic3)
855 IF(ic1==7 .OR. ic4==7)ixs(1,i)=-iabs(ixs(1,i))
856 ENDIF
857 ENDDO
858 ENDDO
859C
860 RETURN