OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_sh3n.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!|| hm_read_sh3n ../starter/source/elements/reader/hm_read_sh3n.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.f
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| anodset ../starter/source/output/analyse/analyse_node.c
30!|| apartset ../starter/source/output/analyse/analyse_part.c
31!|| usr2sys ../starter/source/system/sysfus.F
32!|| vdouble ../starter/source/system/sysfus.F
33!||--- uses -----------------------------------------------------
34!|| message_mod ../starter/share/message_module/message_mod.F
35!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
36!|| submodel_mod ../starter/share/modules1/submodel_mod.F
37!||====================================================================
38 SUBROUTINE hm_read_sh3n(IXTG ,ITAB ,ITABM1 ,IPART ,IPARTTG ,
39 . THK ,PM ,GEO ,ICNOD ,IGEO ,IPM ,
40 . UNITAB ,ANGLE ,LSUBMODEL)
41C-----------------------------------------------
42C ROUTINE DESCRIPTION :
43C ===================
44C READ /SH3N ELEMENTS USING HM_READER
45C-----------------------------------------------
46C DUMMY ARGUMENTS DESCRIPTION:
47C ===================
48C
49C NAME DESCRIPTION
50C
51C IXTG /SH3N ARRAY : CONNECTIVITY, ID, MID PID
52C ITAB USER ID OF NODES
53C ITABM1 REVERSE TAB ITAB
54C IPART PART ARRAY
55C IPARTTG INTERNAL PART ID OF A GIVEN SH3N (INTERNAL ID)
56C THK THICKNESS OF A GIVEN SH3N (INTERNAL ID)
57C PM MATERIAL ARRAY
58C GEO PROP ARRAY (REAL)
59C ICNOD FLAG FOR SH3N WITH ISH3N = 31
60C IGEO PROP ARRAY (INTEGER)
61C IPM MATERIAL ARRAY (INTEGER)
62C UNITAB UNIT ARRAY
63C ANGLE ANGLE OF A GIVEN SH3N (INTERNAL ID)
64C LSUBMODEL SUBMODEL STRUCTURE
65C-----------------------------------------------
66C M o d u l e s
67C-----------------------------------------------
68 USE unitab_mod
69 USE message_mod
70 USE submodel_mod , ONLY : submodel_data
71 USE reader_old_mod , ONLY : line
72 USE user_id_mod , ONLY : id_limit
73 use element_mod , only : nixtg
74C--------------------------------------------------------
75C READING DES ELEMENTS COQUES TRIANGULAIRE
76C--------------------------------------------------------
77C-----------------------------------------------
78C I m p l i c i t T y p e s
79C-----------------------------------------------
80#include "implicit_f.inc"
81C-----------------------------------------------
82C A n a l y s e M o d u l e
83C-----------------------------------------------
84#include "analyse_name.inc"
85C-----------------------------------------------
86C C o m m o n B l o c k s
87C-----------------------------------------------
88#include "com04_c.inc"
89#include "units_c.inc"
90#include "scr03_c.inc"
91#include "scr17_c.inc"
92#include "param_c.inc"
93#include "remesh_c.inc"
94C-----------------------------------------------
95C D u m m y A r g u m e n t s
96C-----------------------------------------------
97C INPUT ARGUMENTS
98 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
99 INTEGER,INTENT(IN)::ITAB(*)
100 INTEGER,INTENT(IN)::ITABM1(*)
101 INTEGER,INTENT(IN)::IPART(LIPART1,*)
102 INTEGER,INTENT(IN)::IGEO(NPROPGI,NUMGEO)
103 INTEGER,INTENT(IN)::IPM(NPROPMI,*)
104 my_real,INTENT(IN)::geo(npropg,*)
105 my_real,INTENT(IN)::pm(npropm,*)
106 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
107C OUTPUT ARGUMENTS
108 INTEGER,INTENT(OUT)::IXTG(NIXTG,*)
109 INTEGER,INTENT(OUT)::IPARTTG(*)
110 INTEGER,INTENT(OUT)::ICNOD(*)
111 my_real,INTENT(OUT)::angle(*)
112 my_real,INTENT(OUT)::thk(*)
113C-----------------------------------------------
114C L o c a l V a r i a b l e s
115C-----------------------------------------------
116 my_real bid,fac_l
117 INTEGER I, J, I1, I2, ID,IDS,IPID,MT,N,MID,PID,UID,STAT,IPARTTG_TMP
118 INTEGER INDEX_PART
119 CHARACTER*40 MESS
120 DATA mess /'3D TRIANGULAR SHELL ELEMENT DEFINITION '/
121 INTEGER ISH3N,KK,IFLAGUNIT
122 INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_SH3N,UID_SH3N,TMP_IPARTTG
123 INTEGER, DIMENSION(:,:), ALLOCATABLE :: TMP_IXTG
124 real*8, DIMENSION(:), ALLOCATABLE :: hm_thk,hm_angle
125C-----------------------------------------------
126C FUNCTION
127C-----------------------------------------------
128 INTEGER USR2SYS
129C--------------------------------------------------
130C ALLOCS & INITS
131c use NUMELTG0 IN PLACE OF NUMELTG ( NBADMESH routine is modifying NUMELTG )
132C--------------------------------------------------
133 ALLOCATE (sub_sh3n(numeltg0),stat=stat)
134 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='SUB_SH3N')
135 ALLOCATE (uid_sh3n(numeltg0),stat=stat)
136 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='UID_SH3N')
137 ALLOCATE (hm_thk(numeltg0),stat=stat)
138 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='HM_THK')
139 ALLOCATE (hm_angle(numeltg0),stat=stat)
140 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='HM_ANGLE')
141 ALLOCATE (tmp_ixtg(nixtg,numeltg0),stat=stat)
142 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='TMP_IXTG')
143 ALLOCATE (tmp_iparttg(numeltg0),stat=stat)
144 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='TMP_IPARTTG')
145 sub_sh3n(1:numeltg0) = 0
146 uid_sh3n(1:numeltg0) = 0
147 tmp_ixtg(1:nixtg,1:numeltg0) = 0
148 tmp_iparttg(1:numeltg0) = 0
149 hm_thk(1:numeltg0) = zero
150 hm_angle(1:numeltg0) = zero
151 index_part = 1
152 uid = -1
153 kk=3
154 i = 0
155C--------------------------------------------------
156C READING SH3NS INPUTS IN HM STRUCTURE
157C--------------------------------------------------
158 CALL cpp_sh3n_read(tmp_ixtg,nixtg,tmp_iparttg,hm_angle,hm_thk,sub_sh3n,uid_sh3n)
159C--------------------------------------------------
160C FILL OTHER STRUCTURES + CHECKS
161C--------------------------------------------------
162 numeltg6 = 0
163 DO WHILE (kk <= 6)
164 DO n=1,numeltg0
165 iparttg_tmp = tmp_iparttg(n)
166
167 IF( ipart(4,index_part) /= iparttg_tmp)THEN
168 DO j=1,npart
169 IF(ipart(4,j)== iparttg_tmp )index_part = j
170 ENDDO
171 ENDIF
172 ish3n = igeo(18,ipart(2,index_part))
173 IF(kk == 6 .AND. ish3n==31) numeltg6 = numeltg6 + 1
174
175 IF((kk==3.AND.ish3n/=31).OR.(kk==6.AND.ish3n==31))THEN
176 i = i + 1
177 icnod(i)=kk
178 DO j=1,nixtg
179 ixtg(j,i) = tmp_ixtg(j,n)
180 ENDDO
181 iparttg(i) = tmp_iparttg(n)
182C--------------------------------------------------
183C FOR _SP _DP PURPOSE
184C--------------------------------------------------
185 angle(i) = hm_angle(n) * pi / hundred80
186 thk(i) = hm_thk(n)
187C--------------------------------------------------
188C SUBMODEL OFFSET
189C--------------------------------------------------
190 IF(sub_sh3n(n) /= 0)THEN
191 IF(uid_sh3n(n) == 0 .AND. lsubmodel(sub_sh3n(n))%UID /= 0) uid_sh3n(n) = lsubmodel(sub_sh3n(n))%UID
192 ENDIF
193C--------------------------------------------------
194C UNITS
195C--------------------------------------------------
196 IF(uid_sh3n(n) /= uid )THEN
197 uid = uid_sh3n(n)
198 iflagunit = 0
199 DO j=1,unitab%NUNITS
200 IF (unitab%UNIT_ID(j) == uid) THEN
201 fac_l = unitab%FAC_L(j)
202 iflagunit = 1
203 ENDIF
204 ENDDO
205 IF (uid/=0.AND.iflagunit==0) THEN
206 CALL ancmsg(msgid=643,anmode=aninfo,msgtype=msgerror,i1=uid,c1='/SH3N')
207 ENDIF
208 ENDIF
209 thk(i) = thk(i) * fac_l
210C--------------------------------------------------
211C INTERNAL PART ID
212C--------------------------------------------------
213 IF( ipart(4,index_part) /= iparttg(i) )THEN
214 DO j=1,npart
215 IF(ipart(4,j)== iparttg(i) ) index_part = j
216 ENDDO
217 ENDIF
218 IF( ipart(4,index_part) /= iparttg(i) ) THEN
219 CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1,c1="SH3N",i1=iparttg(i),i2=iparttg(i),prmod=msg_cumu)
220 ENDIF
221 iparttg(i) = index_part
222C--------------------------------------------------
223 mt=ipart(1,index_part)
224 ipid=ipart(2,index_part)
225 ixtg(1,i)=mt
226 ixtg(5,i)=ipid
227 IF (ixtg(nixtg,i)>id_limit%GLOBAL)THEN
228 CALL ancmsg(msgid=509,anmode=aninfo,msgtype=msgerror,i1=ixtg(nixtg,i),c1=line,c2='/SH3N')
229 ELSEIF (nadmesh/=0.AND.ixtg(nixtg,i)>id_limit%ADMESH)THEN
230 CALL ancmsg(msgid=1069,anmode=aninfo,msgtype=msgerror,i1=ixtg(nixtg,i),c1=line,c2='/SH3N')
231 ENDIF
232 IF(thk(i)>0) THEN
233 CALL apartset(index_part, check_thick_shell)
234 ENDIF
235
236 DO j=2,4
237 ixtg(j,i)=usr2sys(ixtg(j,i),itabm1,mess,id)
238 CALL anodset(ixtg(j,i), check_shell)
239 ENDDO
240 ENDIF
241 IF (i == numeltg0) kk = 7
242 ENDDO
243 IF (i < numeltg0) THEN
244 kk = 6
245 ELSE
246c exit from DOWHILE (kk <=6)
247 kk = 7
248 ENDIF
249 ENDDO
250 IF(ALLOCATED(sub_sh3n)) DEALLOCATE(sub_sh3n)
251 IF(ALLOCATED(uid_sh3n)) DEALLOCATE(uid_sh3n)
252 IF(ALLOCATED(hm_thk)) DEALLOCATE(hm_thk)
253 IF(ALLOCATED(hm_angle)) DEALLOCATE(hm_angle)
254
255 IF(ALLOCATED(tmp_ixtg)) DEALLOCATE(tmp_ixtg)
256 IF(ALLOCATED(tmp_iparttg)) DEALLOCATE(tmp_iparttg)
257C
258 i1=1
259 i2=min0(50,numeltg0)
260C
261 IF(ipri>=5)THEN
262 90 WRITE (iout,'(//A/A//A/)')' TRIANGULAR SHELL ELEMENTS ',' ELEMENT INTERNAL MATER PRSET NODE1 NODE2 NODE3'
263 DO i=i1,i2
264 mid = ipm(1,ixtg(1,i))
265 pid = igeo(1,ixtg(5,i))
266 WRITE (iout,'(7(I10,1X),1PG20.13,1PG20.13)') ixtg(nixtg,i),i,mid,pid,
267 . (itab(ixtg(j,i)),j=2,4),angle(i),thk(i)
268 ENDDO
269 IF(i2==numeltg0)GOTO 200
270 i1=i1+50
271 i2=min0(i2+50,numeltg0)
272 GOTO 90
273 ENDIF
274C
275 200 CONTINUE
276C-----------
277 CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1,prmod=msg_print)
278C-------------------------------------
279C Search for double IDs
280C-------------------------------------
281 ids = 79
282 i = 0
283 j = 0
284 CALL vdouble(ixtg(nixtg,1),nixtg,numeltg0,mess,0,bid)
285 ids = 44
286C
287 RETURN
288 END
anodset
void anodset(int *id, int *type)
Definition analyse_node.c:321
apartset
void apartset(int *id, int *type)
Definition analyse_part.c:112
my_real
#define my_real
Definition cppsort.cpp:32
hm_read_sh3n
subroutine hm_read_sh3n(ixtg, itab, itabm1, ipart, iparttg, thk, pm, geo, icnod, igeo, ipm, unitab, angle, lsubmodel)
Definition hm_read_sh3n.F:41
message_mod
Definition message_mod.F:1257
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
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
lectur
subroutine lectur(multi_fvm, lsubmodel, is_dyna, detonators, ebcs_tab, seatbelt_converted_elements, nb_seatbelt_shells, nb_dyna_include, user_windows, output, mat_elem, names_and_titles, defaults, glob_therm, pblast, sensor_user_struct, check_used)
Definition lectur.F:544
vdouble
subroutine vdouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:868
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:728