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
882C-----------------------------------------------
883C I m p l i c i t T y p e s
884C-----------------------------------------------
885#include "implicit_f.inc"
886C-----------------------------------------------
887C C o m m o n B l o c k s
888C-----------------------------------------------
889#include "scr17_c.inc"
890#include "com04_c.inc"
891#include "param_c.inc"
892C-----------------------------------------------
893C D u m m y A r g u m e n t s
894C-----------------------------------------------
895 INTEGER IPART(LIPART1,*), IGEO(NPROPGI,NUMGEO), IXS(NIXS,*), NSPHSOL
896 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
897 INTEGER,INTENT(IN)::IS_DYNA
898C-----------------------------------------------
899C L o c a l V a r i a b l e s
900C-----------------------------------------------
901 INTEGER I, J, K, IT, NT
902 INTEGER IPID,ID,IDS,N,NSPHDIR,STAT
903 INTEGER FLAG_FMT,FLAG_FMT_TMP,IFIX_TMP,INDEX_PART
904 my_real bid
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-----------------------------------------------
911 INTEGER USR2SYS
912C
913 DATA mess/'3D SOLID ELEMENTS DEFINITION '/
914C=======================================================================
915 nsphsol=0
916C
917C--------------------------------------------------
918C ALLOCS & INITS
919C--------------------------------------------------
920 ALLOCATE (sub_sol(numels),stat=stat)
921 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
922 . msgtype=msgerror,
923 . c1='SUB_SOL')
924 sub_sol(1:numels) = 0
925 index_part = 1
926C--------------------------------------------------
927C READING BRICKS INPUTS IN HM STRUCTURE
928C--------------------------------------------------
929 ALLOCATE(iparts(numels))
930 CALL cpp_brick_read(ixs,nixs,iparts,sub_sol)
931C--------------------------------------------------
932C NSPHSOL NSPHDIR CALCULATION + CHECKS
933C--------------------------------------------------
934 DO i=1,numbrick
935C--------------------------------------------------
936C INTERNAL PART ID
937C--------------------------------------------------
938 IF( ipart(4,index_part) /= iparts(i) )THEN
939 DO j=1,npart
940 IF(ipart(4,j)== iparts(i) )index_part = j
941 ENDDO
942 ENDIF
943 iparts(i) = index_part
944C--------------------------------------------------
945 IF (ixs(11,i)>id_limit%GLOBAL) THEN
946 CALL ancmsg(msgid=509,anmode=aninfo,msgtype=msgerror,
947 . i1=ixs(11,i),c1=line,c2='/SOLID')
948 ENDIF
949C
950 IF (ipart(2,iparts(i)) > 0) THEN
951 nsphdir=igeo(37,ipart(2,iparts(i)))
952 IF(ixs(6,i)+ixs(7,i)+ixs(8,i)+ixs(9,i)==0)THEN
953 nt=0
954 DO it=1,nsphdir
955 nt=nt+it
956 nsphsol=nsphsol+nt
957 END DO
958 ELSEIF(ixs(8,i)+ixs(9,i)==0)THEN
959 nt=0
960 DO it=1,nsphdir
961 nt=nt+it
962 END DO
963 nsphsol=nsphsol+nsphdir*nt
964 ELSE
965 nsphsol=nsphsol+nsphdir*nsphdir*nsphdir
966 ENDIF
967 ENDIF
968C
969 ENDDO
970C
971 flag_fmt = 0
972 i=0
973C--------------------------------------------------
974C READING TETRA4s INPUTS IN HM STRUCTURE
975C--------------------------------------------------
976 CALL cpp_tetra4_read(ixs,nixs,numbrick,iparts,sub_sol)
977C--------------------------------------------------
978C NSPHSOL NSPHDIR CALCULATION + CHECKS
979C--------------------------------------------------
980 DO i=numbrick+1,numbrick+numtetra4
981C--------------------------------------------------
982C INTERNAL PART ID
983C--------------------------------------------------
984 IF( ipart(4,index_part) /= iparts(i) )THEN
985 DO j=1,npart
986 IF(ipart(4,j)== iparts(i) )index_part = j
987 ENDDO
988 ENDIF
989 iparts(i) = index_part
990C--------------------------------------------------
991C
992 nsphdir=igeo(37,ipart(2,iparts(i)))
993 IF (ixs(11,i)>id_limit%GLOBAL) THEN
994 CALL ancmsg(msgid=509,anmode=aninfo,msgtype=msgerror,
995 . i1=ixs(11,i),c1=line,c2='/SOLID')
996 ENDIF
997 nt=0
998 DO it=1,nsphdir
999 nt=nt+it
1000 nsphsol=nsphsol+nt
1001 END DO
1002 ENDDO
1003C--------------------------------------------------
1004C READING PENTA6s INPUTS IN HM STRUCTURE
1005C--------------------------------------------------
1006 IF (is_dyna ==0) CALL cpp_penta6_read(ixs,nixs,numbrick+numtetra4,iparts,sub_sol)
1007C--------------------------------------------------
1008C NSPHSOL NSPHDIR CALCULATION + CHECKS
1009C--------------------------------------------------
1010 DO i=numbrick+numtetra4+1,numbrick+numtetra4+numpenta6
1011C--------------------------------------------------
1012C INTERNAL PART ID
1013C--------------------------------------------------
1014 IF( ipart(4,index_part) /= iparts(i) )THEN
1015 DO j=1,npart
1016 IF(ipart(4,j)== iparts(i) )index_part = j
1017 ENDDO
1018 ENDIF
1019 iparts(i) = index_part
1020C--------------------------------------------------
1021 nsphdir=igeo(37,iparts(i-numbrick))
1022 IF (ixs(11,i)>id_limit%GLOBAL) THEN
1023 CALL ancmsg(msgid=509,anmode=aninfo,msgtype=msgerror,
1024 . i1=ixs(11,i),c1=line,c2='/SOLID')
1025 ENDIF
1026 nt=0
1027 DO it=1,nsphdir
1028 nt=nt+it
1029 nsphsol=nsphsol+nt
1030 END DO
1031 ENDDO
1032 IF (ALLOCATED(iparts)) DEALLOCATE(iparts)
1033 IF (ALLOCATED(sub_sol)) DEALLOCATE(sub_sol)
1034C--------------------------
1035 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
message_mod
Definition message_mod.F:1249
submodel_mod
Definition submodel_mod.F:712
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
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
submodel_mod::submodel_data
Definition submodel_mod.F:723

◆ 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
69C-----------------------------------------------
70C I m p l i c i t T y p e s
71C-----------------------------------------------
72#include "implicit_f.inc"
73C-----------------------------------------------
74C A n a l y s e M o d u l e
75C-----------------------------------------------
76#include "analyse_name.inc"
77C-----------------------------------------------
78C C o m m o n B l o c k s
79C-----------------------------------------------
80#include "scr17_c.inc"
81#include "com04_c.inc"
82#include "param_c.inc"
83C-----------------------------------------------
84C D u m m y A r g u m e n t s
85C-----------------------------------------------
86C INPUT ARGUMENTS
87 INTEGER,INTENT(IN)::ITAB(*)
88 INTEGER,INTENT(IN)::ITABM1(*)
89 INTEGER,INTENT(IN)::IPART(LIPART1,*)
90 INTEGER,INTENT(IN)::IGEO(NPROPGI,*)
91 INTEGER,INTENT(IN)::IS_DYNA
92 my_real,INTENT(IN)::pm(npropm,*)
93 my_real, DIMENSION(3,NUMNOD), INTENT(IN):: x
94 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
95C OUTPUT ARGUMENTS
96 INTEGER,INTENT(OUT)::ISOLNOD(*)
97 INTEGER,INTENT(OUT)::IXS(NIXS,*)
98 INTEGER,INTENT(OUT)::IXS10(6,*)
99 INTEGER,INTENT(OUT)::IXS16(8,*)
100 INTEGER,INTENT(OUT)::IXS20(12,*)
101 INTEGER,INTENT(OUT)::IPARTS(*)
102C-----------------------------------------------
103C L o c a l V a r i a b l e s
104C-----------------------------------------------
105 INTEGER I, J, MT, MLAW, JTUR, I1, I2, INEW,I10,I20,I16
106 INTEGER IC,IC1,IC2,IC3,IC4,IPID,ID,IDS,N,JC,NSPHDIR,STAT
107 INTEGER FLAG_FMT,FLAG_FMT_TMP,IFIX_TMP,NUMELS_READ,
108 . IOUTN, IERROR, 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 Recherche des ID doubles
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:129
checkvolume_8n
function checkvolume_8n(x, ixs)
Definition checksvolume.F:38
checkvolume_4n
function checkvolume_4n(x, ixs)
Definition checksvolume.F:212
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:160
udouble
subroutine udouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:589

◆ 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 527 of file hm_read_solid.F.

531C-----------------------------------------------
532C M o d u l e s
533C-----------------------------------------------
534 USE groupdef_mod
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, IAD, NN
564 INTEGER IC,IC1,IC2,IC3,IC4,MID,PID
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-----------------------------------------------
569 INTEGER USR2SYS
570C
571 DATA mess/'3D SOLID ELEMENTS DEFINITION '/
572 DATA mess2/'3D SOLID ELEMENTS SELECTION FOR TH PLOT '/
573C
574C----------------------------------------------------
575C DETECTION DES ELEMENTS LOIS 6 PAROI---->LOI 17
576C----------------------------------------------------
577C LOI 17 SI LA BCS EST 111 (3D)
578 DO i=1,numels8
579 mt=ixs(1,i)
580 mlaw=nint(pm(19,mt))
581 jtur=nint(pm(70,mt))
582 DO j=2,9
583 IF((mlaw==6.AND.jtur/=0) .OR. mlaw==46) THEN
584 ic=icode(ixs(j,i))
585 ic1=ic/512
586 ic2=(ic-512*ic1)/64
587 ic3=(ic-512*ic1-64*ic2)/8
588 ic4=(ic-512*ic1-64*ic2-8*ic3)
589 IF(ic1==7 .OR. ic4==7)ixs(1,i)=-iabs(ixs(1,i))
590 ENDIF
591 ENDDO
592 ENDDO
593C----------------------------------------------------
594C CLASSEMENT DES ELEMENTS PAR LOI DE MATERIAU
595C----------------------------------------------------
596 CALL reordr(ixs ,nixs ,numels8,pm ,ipoint ,
597 . iparts,ngrbric,igrbric,nummat)
598C------------------------------------------
599C RENUMEROTATION POUR SURFACES
600C------------------------------------------
601 DO i=1,nsurf
602 nn =igrsurf(i)%NSEG
603 DO j=1,nn
604 IF (igrsurf(i)%ELTYP(j) == 1) THEN
605 IF (igrsurf(i)%ELEM(j) <= numels8)
606 . igrsurf(i)%ELEM(j)=ipoint(1,igrsurf(i)%ELEM(j))
607 END IF
608 ENDDO
609 ENDDO
610C------------------------------------------
611C RENUMEROTATION DES PARTICULES SPH
612C------------------------------------------
613 IF(nsphsol/=0)THEN
614 DO i=1,numsph
615 IF(sph2sol(i)/=0)sph2sol(i)=ipoint(1,sph2sol(i))
616 ENDDO
617C
618C Rebuild SOL2SPH, SOL2SPH(1,N)+1<=I<=SOLSPH(2,N) <=> N==SPH2SOL(I)
619 DO n=1,numels8
620 sol2sph(1,n)=0
621 sol2sph(2,n)=0
622 END DO
623 n=sph2sol(first_sphsol)
624 sol2sph(1,n)=0
625 sol2sph(2,n)=sol2sph(1,n)+1
626 DO i=first_sphsol+1,first_sphsol+nsphsol-1
627 IF(sph2sol(i)==n)THEN
628 sol2sph(2,n)=sol2sph(2,n)+1
629 ELSE
630 n=sph2sol(i)
631 sol2sph(1,n)=i-1
632 sol2sph(2,n)=sol2sph(1,n)+1
633 END IF
634 END DO
635 END IF
636C------------------------------------------
637C PERMUTATION DE ISOLNOD
638C------------------------------------------
639 DO i=1,numels8
640 ipoint(2,i)=isolnod(i)
641 ENDDO
642 DO i=1,numels8
643 isolnod(ipoint(1,i))=ipoint(2,i)
644 ENDDO
645C------------------------------------------
646C Reconstruction de la matrice Nod -> Solid elt
647C------------------------------------------
648 DO k=2,9
649 DO i=1,numels
650 n = ixs(k,i)
651 knod2els(n) = knod2els(n) + 1
652 IF(n/=0) nod2els(knod2els(n)) = i
653 END DO
654 END DO
655C
656 DO k=1,6
657 DO i=1,numels10
658 n = ixs10(k,i)
659 IF (n/=0) THEN
660 knod2els(n) = knod2els(n) + 1
661 nod2els(knod2els(n)) = numels8+i
662 END IF
663 END DO
664 END DO
665C
666 DO k=1,12
667 DO i=1,numels20
668 n = ixs20(k,i)
669 IF (n/=0) THEN
670 knod2els(n) = knod2els(n) + 1
671 nod2els(knod2els(n)) = numels10+numels8+i
672 END IF
673 END DO
674 END DO
675C
676 DO k=1,8
677 DO i=1,numels16
678 n = ixs16(k,i)
679 IF (n/=0) THEN
680 knod2els(n) = knod2els(n) + 1
681 nod2els(knod2els(n)) = numels20+numels10+numels8+i
682 END IF
683 END DO
684 END DO
685C
686 DO n=numnod,1,-1
687 knod2els(n+1)=knod2els(n)
688 END DO
689 knod2els(1)=0
690C------------------------------------------
691C PRINT
692C------------------------------------------
693 i1=1
694 i2=50
695C
696 IF(ipri>=5)THEN
697 WRITE (iout,'(//A//)') titre(206)
698 90 CONTINUE
699 i2=min0(i2,numels8)
700 WRITE (iout,'(//A/A//A/A,A/)')
701 . titre(90),titre(91),
702 . ' ELEMENT INTERNAL PART MATER PRSET',
703 . ' NODE1 NODE2 NODE3 NODE4 NODE5',
704 . ' NODE6 NODE7 NODE8'
705 DO i=i1,i2
706 inew=ipoint(1,i)
707 WRITE (iout,'(5I10)')
708 . ixs(11,inew),inew,ipart(4,iparts(inew)),
709 . ipart(5,iparts(inew)),ipart(6,iparts(inew))
710 IF(isolnod(inew)==4)THEN
711 WRITE (iout,'(8I10)')
712 . itab(ixs(2,inew)),itab(ixs(4,inew)),
713 . itab(ixs(7,inew)),itab(ixs(6,inew))
714 ELSEIF(isolnod(inew)==6)THEN
715 WRITE (iout,'(6I10)')
716 . itab(ixs(5,inew)),itab(ixs(3,inew)),itab(ixs(4,inew)),
717 . itab(ixs(6,inew)),itab(ixs(7,inew)),itab(ixs(8,inew))
718 ELSE
719 WRITE (iout,'(8I10)')
720 . (itab(ixs(j,inew)),j=2,9)
721 ENDIF
722 ENDDO
723 IF(i2==numels8)GOTO 200
724 i1=i1+50
725 i2=i2+50
726 GOTO 90
727C
728 200 CONTINUE
729 i1=1
730 i2=50
731C
732 290 CONTINUE
733 WRITE (iout,'(//A/A//A/A,A/)')
734 . ' TEN NODE TETRA ELEMENTS',
735 . ' -----------------------',
736 . ' ELEMENT INTERNAL PART MATER PRSET',
737 . ' NODE1 NODE2 NODE3 NODE4 NODE5',
738 . ' NODE6 NODE7 NODE8 NODE9 NODE10'
739 i2=min0(i2,numels10)
740 DO i=i1,i2
741 inew=i+numels8
742 WRITE (iout,'(5I10)')
743 . ixs(11,inew),inew,ipart(4,iparts(inew)),
744 . ipart(5,iparts(inew)),ipart(6,iparts(inew))
745 WRITE (iout,'(10I10)')
746 . itab(ixs(2,inew)),itab(ixs(4,inew)),
747 . itab(ixs(7,inew)),itab(ixs(6,inew)),
748 . (itab(ixs10(j,i)),j=1,6)
749 ENDDO
750 IF(i2==numels10)GOTO 300
751 i1=i1+50
752 i2=i2+50
753 GOTO 290
754C
755 300 CONTINUE
756 i1=1
757 i2=50
758C
759 dowhile(i1<=numels20)
760 WRITE (iout,'(//A/A//A/A,A/A/A)')
761 . ' TWENTY NODE BRICK ELEMENTS',
762 . ' --------------------------',
763 . ' ELEMENT INTERNAL PART MATER PRSET',
764 . ' NODE1 NODE2 NODE3 NODE4 NODE5',
765 . ' NODE6 NODE7 NODE8',
766 . ' NODE9 NODE10 NODE11 NODE12 NODE13 NODE14',
767 . ' NODE15 NODE16 NODE17 NODE18 NODE19 NODE20'
768 i2=min0(i2,numels20)
769 DO i=i1,i2
770 inew=i+numels8+numels10
771 WRITE (iout,'(5I10)')
772 . ixs(11,inew),inew,ipart(4,iparts(inew)),
773 . ipart(5,iparts(inew)),ipart(6,iparts(inew))
774 WRITE (iout,'(8I10/6I10/6I10)')
775 . (itab(ixs(j,inew)),j=2,9),
776 . (itab(ixs20(j,i)),j=1,12)
777 ENDDO
778 i1=i1+50
779 i2=i2+50
780 ENDDO
781 i1=1
782 i2=50
783C
784 dowhile(i1<=numels16)
785 WRITE (iout,'(//A/A//A/A,A/A,A)')
786 . ' SIXTEEN NODE SHELL ELEMENTS',
787 . ' ---------------------------',
788 . ' ELEMENT INTERNAL PART MATER PRSET',
789 . ' NODE1 NODE2 NODE3 NODE4 NODE5',
790 . ' NODE6 NODE7 NODE8',
791 . ' NODE9 NODE10 NODE11 NODE12 NODE13 NODE14',
792 . ' NODE15 NODE16'
793 i2=min0(i2,numels16)
794 DO i=i1,i2
795 inew=i+numels8+numels10+numels20
796 WRITE (iout,'(5I10)')
797 . ixs(11,inew),inew,ipart(4,iparts(inew)),
798 . ipart(5,iparts(inew)),ipart(6,iparts(inew))
799 WRITE (iout,'(8I10/8I10)')
800 . (itab(ixs(j,inew)),j=2,9),
801 . (itab(ixs16(j,i)),j=1,8)
802 ENDDO
803 i1=i1+50
804 i2=i2+50
805 ENDDO
806 ENDIF
807C
808 RETURN
groupdef_mod
Definition groupdef_mod.F:662
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.

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