OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_shell.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/.
23C
24!||====================================================================
25!|| hm_read_shell ../starter/source/elements/reader/hm_read_shell.F
26!||--- called by ------------------------------------------------------
27!|| lectur ../starter/source/starter/lectur.F
28!||--- calls -----------------------------------------------------
29!|| ancmsg ../starter/source/output/message/message.F
30!|| anodset ../starter/source/output/analyse/analyse_node.c
31!|| apartset ../starter/source/output/analyse/analyse_part.c
32!|| usr2sys ../starter/source/system/sysfus.F
33!|| vdouble ../starter/source/system/sysfus.F
34!||--- uses -----------------------------------------------------
35!|| message_mod ../starter/share/message_module/message_mod.F
36!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
37!|| submodel_mod ../starter/share/modules1/submodel_mod.F
38!||====================================================================
39 SUBROUTINE hm_read_shell(IXC ,ITAB ,ITABM1,IPART,IPARTC,
40 . THK ,IPM ,IGEO ,UNITAB,ITAG ,ANGLE ,LSUBMODEL)
41C-----------------------------------------------
42C ROUTINE DESCRIPTION :
43C ===================
44C READ /SHELL ELEMENTS USING HM_READER
45C-----------------------------------------------
46C DUMMY ARGUMENTS DESCRIPTION:
47C ===================
48C
49C NAME DESCRIPTION
50C
51C IXC /SHELL ARRAY : CONNECTIVITY, ID, MID PID
52C ITAB USER ID OF NODES
53C ITABM1 REVERSE TAB ITAB
54C IPART PART ARRAY
55C IPARTC INTERNAL PART ID OF A GIVEN SHELL (INTERNAL ID)
56C THK THICKNESS OF A GIVEN SHELL (INTERNAL ID)
57C IPM MATERIAL ARRAY (INTEGER)
58C IGEO PROP ARRAY (INTEGER)
59C ITAG XFEM TAG
60C UNITAB UNIT ARRAY
61C ANGLE ANGLE OF A GIVEN SHELL (INTERNAL ID)
62C LSUBMODEL SUBMODEL STRUCTURE
63C-----------------------------------------------
64C M o d u l e s
65C-----------------------------------------------
66 USE unitab_mod
67 USE message_mod
68 USE submodel_mod , ONLY : nsubmod, submodel_data
69 USE names_and_titles_mod , ONLY : nchartitle
70 USE reader_old_mod , ONLY : line
71 USE user_id_mod , ONLY : id_limit
72 use element_mod , only : nixc
73C--------------------------------------------------------
74C READING DES ELEMENTS COQUES 4 NODES
75C VERSIION NUMEROTATION DES NODES LIBRE/MARS 90/DIM
76C--------------------------------------------------------
77C
78C-----------------------------------------------
79C I m p l i c i t T y p e s
80C-----------------------------------------------
81#include "implicit_f.inc"
82C-----------------------------------------------
83C A n a l y s e M o d u l e
84C-----------------------------------------------
85#include "analyse_name.inc"
86C-----------------------------------------------
87C C o m m o n B l o c k s
88C-----------------------------------------------
89#include "scr17_c.inc"
90#include "com04_c.inc"
91#include "units_c.inc"
92#include "scr03_c.inc"
93#include "param_c.inc"
94#include "titr_c.inc"
95#include "remesh_c.inc"
96C-----------------------------------------------
97C D u m m y A r g u m e n t s
98C-----------------------------------------------
99C INPUT ARGUMENTS
100 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
101 INTEGER,INTENT(IN)::ITAB(*)
102 INTEGER,INTENT(IN)::ITABM1(*)
103 INTEGER,INTENT(IN)::IPART(LIPART1,*)
104 INTEGER,INTENT(IN)::IGEO(NPROPGI,*)
105 INTEGER,INTENT(IN)::IPM(NPROPMI,*)
106 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(NSUBMOD)
107C OUTPUT ARGUMENTS
108 INTEGER,INTENT(OUT)::IXC(NIXC,*)
109 INTEGER,INTENT(OUT)::IPARTC(*)
110 INTEGER,INTENT(OUT)::ITAG(*)
111 my_real,
112 . INTENT(OUT)::angle(*)
113 my_real,
114 . INTENT(OUT)::thk(*)
115C-----------------------------------------------
116C L o c a l V a r i a b l e s
117C-----------------------------------------------
118 INTEGER I, J, I1, I2, ID,IDS,IPID,MT,MID,PID,UID,NDEGEN,STAT,
119 . iflagunit,ishxfem,index_part
120 CHARACTER MESS*40, MESS2*40
121 my_real
122 . bid,fac_l
123 INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_SHELL,UID_SHELL
124 real*8, DIMENSION(:), ALLOCATABLE :: hm_thk,hm_angle
125C-----------------------------------------------
126C E x t e r n a l F u n c t i o n s
127C-----------------------------------------------
128 INTEGER USR2SYS
129 DATA mess/'3D SHELL ELEMENTS DEFINITION '/
130 DATA mess2/'3D SHELL ELEMENTS SELECTION FOR TH PLOT '/
131C=======================================================================
132C--------------------------------------------------
133C ALLOCS & INITS
134c use NUMELC0 IN PLACE OF NUMELC ( NBADMESH routine is modifying NUMELC )
135C--------------------------------------------------
136 ALLOCATE (sub_shell(numelc0),stat=stat)
137 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
138 . msgtype=msgerror,
139 . c1='SUB_SHELL')
140 ALLOCATE (uid_shell(numelc0),stat=stat)
141 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
142 . msgtype=msgerror,
143 . c1='UID_SHELL')
144 ALLOCATE (hm_thk(numelc0),stat=stat)
145 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
146 . msgtype=msgerror,
147 . c1='HM_THK')
148 ALLOCATE (hm_angle(numelc0),stat=stat)
149 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
150 . msgtype=msgerror,
151 . c1='HM_ANGLE')
152 sub_shell(1:numelc0) = 0
153 uid_shell(1:numelc0) = 0
154 hm_thk(1:numelc0) = zero
155 hm_angle(1:numelc0) = zero
156 ndegen = 0
157 index_part = 1
158 uid = -1
159C--------------------------------------------------
160C READING SHELLS INPUTS IN HM STRUCTURE
161C--------------------------------------------------
162 CALL cpp_shell_read(ixc,nixc,ipartc,hm_angle,hm_thk,sub_shell,uid_shell)
163C--------------------------------------------------
164C FILL OTHER STRUCTURES + CHECKS
165C--------------------------------------------------
166 DO i=1,numelc0
167C--------------------------------------------------
168C FOR _SP _DP PURPOSE
169C--------------------------------------------------
170 angle(i) = hm_angle(i) * pi / hundred80
171 thk(i) = hm_thk(i)
172C--------------------------------------------------
173C SUBMODEL OFFSET
174C--------------------------------------------------
175 IF(sub_shell(i) /= 0)THEN
176 IF(uid_shell(i) == 0 .AND. lsubmodel(sub_shell(i))%UID /= 0)
177 . uid_shell(i) = lsubmodel(sub_shell(i))%UID
178 ENDIF
179C--------------------------------------------------
180C UNITS
181C--------------------------------------------------
182 fac_l = one
183 IF(uid_shell(i) /= uid )THEN
184 uid = uid_shell(i)
185 iflagunit = 0
186 DO j=1,unitab%NUNITS
187 IF (unitab%UNIT_ID(j) == uid) THEN
188 fac_l = unitab%FAC_L(j)
189 iflagunit = 1
190 ENDIF
191 ENDDO
192 IF (uid/=0.AND.iflagunit==0) THEN
193 CALL ancmsg(msgid=643,anmode=aninfo,msgtype=msgerror,
194 . i1=uid,c1='/SHELL')
195 ENDIF
196 ENDIF
197 thk(i) = thk(i) * fac_l
198C--------------------------------------------------
199C INTERNAL PART ID
200C--------------------------------------------------
201 IF( ipart(4,index_part) /= ipartc(i) )THEN
202 DO j=1,npart
203 IF(ipart(4,j)== ipartc(i) ) index_part = j
204 ENDDO
205 ENDIF
206 IF(ipart(4,index_part) /= ipartc(i)) THEN
207 CALL ancmsg(msgid=402,
208 . msgtype=msgerror,
209 . anmode=aninfo_blind_1,
210 . c1="SHELL",
211 . i1=ipartc(i),
212 . i2=ipartc(i),
213 . prmod=msg_cumu)
214 ENDIF
215 ipartc(i) = index_part
216C--------------------------------------------------
217 mt=ipart(1,index_part)
218 ipid=ipart(2,index_part)
219 ixc(1,i)=mt
220 ixc(6,i)=ipid
221 IF (ixc(nixc,i)>id_limit%GLOBAL)THEN
222 CALL ancmsg(msgid=509,anmode=aninfo,msgtype=msgerror,
223 . i1=ixc(nixc,i),c1=line,c2='/SHELL')
224 ELSEIF (nadmesh/=0.AND.ixc(nixc,i)>id_limit%ADMESH)THEN
225 CALL ancmsg(msgid=1069,anmode=aninfo,msgtype=msgerror,
226 . i1=ixc(nixc,i),c1=line,c2='/SHELL')
227 ENDIF
228 IF( ( ixc(4,i) == ixc(5,i)) .OR.
229 . ( ixc(5,i) == 0 )) THEN
230 ndegen = ndegen + 1
231 CALL ancmsg(msgid=430,
232 . msgtype=msgwarning,
233 . i1=ixc(nixc,i),
234 . anmode=aninfo_blind_2,
235 . prmod=msg_cumu)
236 ENDIF
237 IF(thk(i)>0) THEN
238 CALL apartset(index_part, check_thick_shell)
239 ENDIF
240
241 DO j=2,5
242 ixc(j,i)=usr2sys(ixc(j,i),itabm1,mess,id)
243 CALL anodset(ixc(j,i), check_shell)
244 ENDDO
245
246 ishxfem = igeo(19,ipid)
247
248 IF(ishxfem > 0) THEN
249 DO j=2,5
250 itag(ixc(j,i)) = 1
251 ENDDO
252 ENDIF
253 ENDDO
254c
255C
256 IF(ALLOCATED(sub_shell)) DEALLOCATE(sub_shell)
257 IF(ALLOCATED(uid_shell)) DEALLOCATE(uid_shell)
258 IF(ALLOCATED(hm_thk)) DEALLOCATE(hm_thk)
259 IF(ALLOCATED(hm_angle)) DEALLOCATE(hm_angle)
260C
261 i1=1
262 i2=min0(50,numelc0)
263C
264 IF(ipri>=5)THEN
265 90 WRITE (iout,'(//A/A//A,A/)')titre(110),titre(111),titre(102),titre(105)
266 DO i=i1,i2
267 mid = ipm(1,ixc(1,i))
268 pid = igeo(1,ixc(6,i))
269 WRITE (iout,fmt='(8(I10,1X),1PG20.13,1X,1PG20.13)') ixc(nixc,i),i,mid,pid,
270 . (itab(ixc(j,i)),j=2,5),angle(i),thk(i)
271 ENDDO
272 IF(i2==numelc0)GOTO 200
273 i1=i1+50
274 i2=min0(i2+50,numelc0)
275 GOTO 90
276 ENDIF
277C
278 200 CONTINUE
279C-----------
280 CALL ancmsg(msgid=402,
281 . msgtype=msgerror,
282 . anmode=aninfo_blind_1,
283 . prmod=msg_print)
284C-------------------------------------
285C Search Duplicated Ids
286C-------------------------------------
287 ids = 79
288 i = 0
289 j = 0
290 CALL vdouble(ixc(nixc,1),nixc,numelc0,mess,0,bid)
291 ids = 17
292
293 RETURN
294
295 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_shell
subroutine hm_read_shell(ixc, itab, itabm1, ipart, ipartc, thk, ipm, igeo, unitab, itag, angle, lsubmodel)
Definition hm_read_shell.F:41
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
submodel_mod
Definition submodel_mod.F:717
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725
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
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