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!|| nintrn ../starter/source/system/nintrn.F
33!|| usr2sys ../starter/source/system/sysfus.F
34!|| vdouble ../starter/source/system/sysfus.F
35!||--- uses -----------------------------------------------------
36!|| message_mod ../starter/share/message_module/message_mod.F
37!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
38!|| submodel_mod ../starter/share/modules1/submodel_mod.F
39!||====================================================================
40 SUBROUTINE hm_read_shell(IXC ,ITAB ,ITABM1,IPART,IPARTC,
41 . THK ,IPM ,IGEO ,UNITAB,ITAG ,ANGLE ,LSUBMODEL)
42C-----------------------------------------------
43C ROUTINE DESCRIPTION :
44C ===================
45C READ /SHELL ELEMENTS USING HM_READER
46C-----------------------------------------------
47C DUMMY ARGUMENTS DESCRIPTION:
48C ===================
49C
50C NAME DESCRIPTION
51C
52C IXC /SHELL ARRAY : CONNECTIVITY, ID, MID PID
53C ITAB USER ID OF NODES
54C ITABM1 REVERSE TAB ITAB
55C IPART PART ARRAY
56C IPARTC INTERNAL PART ID OF A GIVEN SHELL (INTERNAL ID)
57C THK THICKNESS OF A GIVEN SHELL (INTERNAL ID)
58C IPM MATERIAL ARRAY (INTEGER)
59C IGEO PROP ARRAY (INTEGER)
60C ITAG XFEM TAG
61C UNITAB UNIT ARRAY
62C ANGLE ANGLE OF A GIVEN SHELL (INTERNAL ID)
63C LSUBMODEL SUBMODEL STRUCTURE
64C-----------------------------------------------
65C M o d u l e s
66C-----------------------------------------------
67 USE unitab_mod
68 USE message_mod
69 USE submodel_mod , ONLY : nsubmod, submodel_data
70 USE names_and_titles_mod , ONLY : nchartitle
71 USE reader_old_mod , ONLY : line
72 USE user_id_mod , ONLY : id_limit
73C--------------------------------------------------------
74C LECTURE DES ELEMENTS COQUES 4 NOEUDS
75C VERSIION NUMEROTATION DES NOEUDS 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,N,MID,PID,UID,NDEGEN,JC,STAT,
119 . iflagunit,flag_fmt,flag_fmt_tmp,ifix_tmp,ishxfem,ioutn,ierror,index_part
120 CHARACTER MESS*40, MESS2*40
121 CHARACTER(LEN=NCHARTITLE) :: TITR
122 my_real
123 . bid,fac_l
124 INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_SHELL,UID_SHELL
125 real*8, DIMENSION(:), ALLOCATABLE :: hm_thk,hm_angle
126C-----------------------------------------------
127C E x t e r n a l F u n c t i o n s
128C-----------------------------------------------
129 INTEGER NINTRN
130 INTEGER USR2SYS
131 DATA mess/'3D SHELL ELEMENTS DEFINITION '/
132 DATA mess2/'3D SHELL ELEMENTS SELECTION FOR TH PLOT '/
133C=======================================================================
134C--------------------------------------------------
135C ALLOCS & INITS
136c use NUMELC0 IN PLACE OF NUMELC ( NBADMESH routine is modifying NUMELC )
137C--------------------------------------------------
138 ALLOCATE (sub_shell(numelc0),stat=stat)
139 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
140 . msgtype=msgerror,
141 . c1='SUB_SHELL')
142 ALLOCATE (uid_shell(numelc0),stat=stat)
143 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
144 . msgtype=msgerror,
145 . c1='UID_SHELL')
146 ALLOCATE (hm_thk(numelc0),stat=stat)
147 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
148 . msgtype=msgerror,
149 . c1='HM_THK')
150 ALLOCATE (hm_angle(numelc0),stat=stat)
151 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
152 . msgtype=msgerror,
153 . c1='HM_ANGLE')
154 sub_shell(1:numelc0) = 0
155 uid_shell(1:numelc0) = 0
156 hm_thk(1:numelc0) = zero
157 hm_angle(1:numelc0) = zero
158 ndegen = 0
159 index_part = 1
160 uid = -1
161C--------------------------------------------------
162C READING SHELLS INPUTS IN HM STRUCTURE
163C--------------------------------------------------
164 CALL cpp_shell_read(ixc,nixc,ipartc,hm_angle,hm_thk,sub_shell,uid_shell)
165C--------------------------------------------------
166C FILL OTHER STRUCTURES + CHECKS
167C--------------------------------------------------
168 DO i=1,numelc0
169C--------------------------------------------------
170C FOR _SP _DP PURPOSE
171C--------------------------------------------------
172 angle(i) = hm_angle(i) * pi / hundred80
173 thk(i) = hm_thk(i)
174C--------------------------------------------------
175C SUBMODEL OFFSET
176C--------------------------------------------------
177 IF(sub_shell(i) /= 0)THEN
178 IF(uid_shell(i) == 0 .AND. lsubmodel(sub_shell(i))%UID /= 0)
179 . uid_shell(i) = lsubmodel(sub_shell(i))%UID
180 ENDIF
181C--------------------------------------------------
182C UNITS
183C--------------------------------------------------
184 fac_l = one
185 IF(uid_shell(i) /= uid )THEN
186 uid = uid_shell(i)
187 iflagunit = 0
188 DO j=1,unitab%NUNITS
189 IF (unitab%UNIT_ID(j) == uid) THEN
190 fac_l = unitab%FAC_L(j)
191 iflagunit = 1
192 ENDIF
193 ENDDO
194 IF (uid/=0.AND.iflagunit==0) THEN
195 CALL ancmsg(msgid=643,anmode=aninfo,msgtype=msgerror,
196 . i1=uid,c1='/SHELL')
197 ENDIF
198 ENDIF
199 thk(i) = thk(i) * fac_l
200C--------------------------------------------------
201C INTERNAL PART ID
202C--------------------------------------------------
203 IF( ipart(4,index_part) /= ipartc(i) )THEN
204 DO j=1,npart
205 IF(ipart(4,j)== ipartc(i) ) index_part = j
206 ENDDO
207 ENDIF
208 IF(ipart(4,index_part) /= ipartc(i)) THEN
209 CALL ancmsg(msgid=402,
210 . msgtype=msgerror,
211 . anmode=aninfo_blind_1,
212 . c1="SHELL",
213 . i1=ipartc(i),
214 . i2=ipartc(i),
215 . prmod=msg_cumu)
216 ENDIF
217 ipartc(i) = index_part
218C--------------------------------------------------
219 mt=ipart(1,index_part)
220 ipid=ipart(2,index_part)
221 ixc(1,i)=mt
222 ixc(6,i)=ipid
223 IF (ixc(nixc,i)>id_limit%GLOBAL)THEN
224 CALL ancmsg(msgid=509,anmode=aninfo,msgtype=msgerror,
225 . i1=ixc(nixc,i),c1=line,c2='/SHELL')
226 ELSEIF (nadmesh/=0.AND.ixc(nixc,i)>id_limit%ADMESH)THEN
227 CALL ancmsg(msgid=1069,anmode=aninfo,msgtype=msgerror,
228 . i1=ixc(nixc,i),c1=line,c2='/SHELL')
229 ENDIF
230 IF( ( ixc(4,i) == ixc(5,i)) .OR.
231 . ( ixc(5,i) == 0 )) THEN
232 ndegen = ndegen + 1
233 CALL ancmsg(msgid=430,
234 . msgtype=msgwarning,
235 . i1=ixc(nixc,i),
236 . anmode=aninfo_blind_2,
237 . prmod=msg_cumu)
238 ENDIF
239 IF(thk(i)>0) THEN
240 CALL apartset(index_part, check_thick_shell)
241 ENDIF
242
243 DO j=2,5
244 ixc(j,i)=usr2sys(ixc(j,i),itabm1,mess,id)
245 CALL anodset(ixc(j,i), check_shell)
246 ENDDO
247
248 ishxfem = igeo(19,ipid)
249
250 IF(ishxfem > 0) THEN
251 DO j=2,5
252 itag(ixc(j,i)) = 1
253 ENDDO
254 ENDIF
255 ENDDO
256c
257C
258 IF(ALLOCATED(sub_shell)) DEALLOCATE(sub_shell)
259 IF(ALLOCATED(uid_shell)) DEALLOCATE(uid_shell)
260 IF(ALLOCATED(hm_thk)) DEALLOCATE(hm_thk)
261 IF(ALLOCATED(hm_angle)) DEALLOCATE(hm_angle)
262C
263 i1=1
264 i2=min0(50,numelc0)
265C
266 IF(ipri>=5)THEN
267 90 WRITE (iout,'(//A/A//A,A/)')titre(110),titre(111),titre(102),titre(105)
268 DO i=i1,i2
269 mid = ipm(1,ixc(1,i))
270 pid = igeo(1,ixc(6,i))
271 WRITE (iout,fmt='(8(I10,1X),1PG20.13,1X,1PG20.13)') ixc(nixc,i),i,mid,pid,
272 . (itab(ixc(j,i)),j=2,5),angle(i),thk(i)
273 ENDDO
274 IF(i2==numelc0)GOTO 200
275 i1=i1+50
276 i2=min0(i2+50,numelc0)
277 GOTO 90
278 ENDIF
279C
280 200 CONTINUE
281C-----------
282 CALL ancmsg(msgid=402,
283 . msgtype=msgerror,
284 . anmode=aninfo_blind_1,
285 . prmod=msg_print)
286C-------------------------------------
287C Search Duplicated Ids
288C-------------------------------------
289 ids = 79
290 i = 0
291 j = 0
292 CALL vdouble(ixc(nixc,1),nixc,numelc0,mess,0,bid)
293 ids = 17
294
295 RETURN
296
297 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:42
id
initmumps id
Definition multiplerhs_example.m:4
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
submodel_mod
Definition submodel_mod.F:712
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
unitab_mod
Definition unitab_mod.F:513
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
vdouble
subroutine vdouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:884
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723