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!|| nintrn ../starter/source/system/nintrn.F
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_sh3n(IXTG ,ITAB ,ITABM1 ,IPART ,IPARTTG ,
40 . THK ,PM ,GEO ,ICNOD ,IGEO ,IPM ,
41 . UNITAB ,ANGLE ,LSUBMODEL)
42C-----------------------------------------------
43C ROUTINE DESCRIPTION :
44C ===================
45C READ /SH3N ELEMENTS USING HM_READER
46C-----------------------------------------------
47C DUMMY ARGUMENTS DESCRIPTION:
48C ===================
49C
50C NAME DESCRIPTION
51C
52C IXTG /SH3N ARRAY : CONNECTIVITY, ID, MID PID
53C ITAB USER ID OF NODES
54C ITABM1 REVERSE TAB ITAB
55C IPART PART ARRAY
56C IPARTTG INTERNAL PART ID OF A GIVEN SH3N (INTERNAL ID)
57C THK THICKNESS OF A GIVEN SH3N (INTERNAL ID)
58C PM MATERIAL ARRAY
59C GEO PROP ARRAY (REAL)
60C ICNOD FLAG FOR SH3N WITH ISH3N = 31
61C IGEO PROP ARRAY (INTEGER)
62C IPM MATERIAL ARRAY (INTEGER)
63C UNITAB UNIT ARRAY
64C ANGLE ANGLE OF A GIVEN SH3N (INTERNAL ID)
65C LSUBMODEL SUBMODEL STRUCTURE
66C-----------------------------------------------
67C M o d u l e s
68C-----------------------------------------------
69 USE unitab_mod
70 USE message_mod
71 USE submodel_mod , ONLY : nsubmod, submodel_data
72 USE reader_old_mod , ONLY : line
73 USE user_id_mod , ONLY : id_limit
74C--------------------------------------------------------
75C LECTURE 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,JC,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
129 INTEGER NINTRN
130C--------------------------------------------------
131C ALLOCS & INITS
132c use NUMELTG0 IN PLACE OF NUMELTG ( NBADMESH routine is modifying NUMELTG )
133C--------------------------------------------------
134 ALLOCATE (sub_sh3n(numeltg0),stat=stat)
135 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='SUB_SH3N')
136 ALLOCATE (uid_sh3n(numeltg0),stat=stat)
137 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='UID_SH3N')
138 ALLOCATE (hm_thk(numeltg0),stat=stat)
139 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='HM_THK')
140 ALLOCATE (hm_angle(numeltg0),stat=stat)
141 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='HM_ANGLE')
142 ALLOCATE (tmp_ixtg(nixtg,numeltg0),stat=stat)
143 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='TMP_IXTG')
144 ALLOCATE (tmp_iparttg(numeltg0),stat=stat)
145 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='TMP_IPARTTG')
146 sub_sh3n(1:numeltg0) = 0
147 uid_sh3n(1:numeltg0) = 0
148 tmp_ixtg(1:nixtg,1:numeltg0) = 0
149 tmp_iparttg(1:numeltg0) = 0
150 hm_thk(1:numeltg0) = zero
151 hm_angle(1:numeltg0) = zero
152 index_part = 1
153 uid = -1
154 kk=3
155 i = 0
156C--------------------------------------------------
157C READING SH3NS INPUTS IN HM STRUCTURE
158C--------------------------------------------------
159 CALL cpp_sh3n_read(tmp_ixtg,nixtg,tmp_iparttg,hm_angle,hm_thk,sub_sh3n,uid_sh3n)
160C--------------------------------------------------
161C FILL OTHER STRUCTURES + CHECKS
162C--------------------------------------------------
163 numeltg6 = 0
164 DO WHILE (kk <= 6)
165 DO n=1,numeltg0
166 iparttg_tmp = tmp_iparttg(n)
167
168 IF( ipart(4,index_part) /= iparttg_tmp)THEN
169 DO j=1,npart
170 IF(ipart(4,j)== iparttg_tmp )index_part = j
171 ENDDO
172 ENDIF
173 ish3n = igeo(18,ipart(2,index_part))
174 IF(kk == 6 .AND. ish3n==31) numeltg6 = numeltg6 + 1
175
176 IF((kk==3.AND.ish3n/=31).OR.(kk==6.AND.ish3n==31))THEN
177 i = i + 1
178 icnod(i)=kk
179 DO j=1,nixtg
180 ixtg(j,i) = tmp_ixtg(j,n)
181 ENDDO
182 iparttg(i) = tmp_iparttg(n)
183C--------------------------------------------------
184C FOR _SP _DP PURPOSE
185C--------------------------------------------------
186 angle(i) = hm_angle(n) * pi / hundred80
187 thk(i) = hm_thk(n)
188C--------------------------------------------------
189C SUBMODEL OFFSET
190C--------------------------------------------------
191 IF(sub_sh3n(n) /= 0)THEN
192 IF(uid_sh3n(n) == 0 .AND. lsubmodel(sub_sh3n(n))%UID /= 0) uid_sh3n(n) = lsubmodel(sub_sh3n(n))%UID
193 ENDIF
194C--------------------------------------------------
195C UNITS
196C--------------------------------------------------
197 IF(uid_sh3n(n) /= uid )THEN
198 uid = uid_sh3n(n)
199 iflagunit = 0
200 DO j=1,unitab%NUNITS
201 IF (unitab%UNIT_ID(j) == uid) THEN
202 fac_l = unitab%FAC_L(j)
203 iflagunit = 1
204 ENDIF
205 ENDDO
206 IF (uid/=0.AND.iflagunit==0) THEN
207 CALL ancmsg(msgid=643,anmode=aninfo,msgtype=msgerror,i1=uid,c1='/SH3N')
208 ENDIF
209 ENDIF
210 thk(i) = thk(i) * fac_l
211C--------------------------------------------------
212C INTERNAL PART ID
213C--------------------------------------------------
214 IF( ipart(4,index_part) /= iparttg(i) )THEN
215 DO j=1,npart
216 IF(ipart(4,j)== iparttg(i) ) index_part = j
217 ENDDO
218 ENDIF
219 IF( ipart(4,index_part) /= iparttg(i) ) THEN
220 CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1,c1="SH3N",i1=iparttg(i),i2=iparttg(i),prmod=msg_cumu)
221 ENDIF
222 iparttg(i) = index_part
223C--------------------------------------------------
224 mt=ipart(1,index_part)
225 ipid=ipart(2,index_part)
226 ixtg(1,i)=mt
227 ixtg(5,i)=ipid
228 IF (ixtg(nixtg,i)>id_limit%GLOBAL)THEN
229 CALL ancmsg(msgid=509,anmode=aninfo,msgtype=msgerror,i1=ixtg(nixtg,i),c1=line,c2='/SH3N')
230 ELSEIF (nadmesh/=0.AND.ixtg(nixtg,i)>id_limit%ADMESH)THEN
231 CALL ancmsg(msgid=1069,anmode=aninfo,msgtype=msgerror,i1=ixtg(nixtg,i),c1=line,c2='/SH3N')
232 ENDIF
233 IF(thk(i)>0) THEN
234 CALL apartset(index_part, check_thick_shell)
235 ENDIF
236
237 DO j=2,4
238 ixtg(j,i)=usr2sys(ixtg(j,i),itabm1,mess,id)
239 CALL anodset(ixtg(j,i), check_shell)
240 ENDDO
241 ENDIF
242 IF (i == numeltg0) kk = 7
243 ENDDO
244 IF (i < numeltg0) THEN
245 kk = 6
246 ELSE
247c exit from DOWHILE (kk <=6)
248 kk = 7
249 ENDIF
250 ENDDO
251 IF(ALLOCATED(sub_sh3n)) DEALLOCATE(sub_sh3n)
252 IF(ALLOCATED(uid_sh3n)) DEALLOCATE(uid_sh3n)
253 IF(ALLOCATED(hm_thk)) DEALLOCATE(hm_thk)
254 IF(ALLOCATED(hm_angle)) DEALLOCATE(hm_angle)
255
256 IF(ALLOCATED(tmp_ixtg)) DEALLOCATE(tmp_ixtg)
257 IF(ALLOCATED(tmp_iparttg)) DEALLOCATE(tmp_iparttg)
258C
259 i1=1
260 i2=min0(50,numeltg0)
261C
262 IF(ipri>=5)THEN
263 90 WRITE (iout,'(//A/A//A/)')' TRIANGULAR SHELL ELEMENTS ',' ELEMENT INTERNAL MATER PRSET NODE1 NODE2 NODE3'
264 DO i=i1,i2
265 mid = ipm(1,ixtg(1,i))
266 pid = igeo(1,ixtg(5,i))
267 WRITE (iout,'(7(I10,1X),1PG20.13,1PG20.13)') ixtg(nixtg,i),i,mid,pid,
268 . (itab(ixtg(j,i)),j=2,4),angle(i),thk(i)
269 ENDDO
270 IF(i2==numeltg0)GOTO 200
271 i1=i1+50
272 i2=min0(i2+50,numeltg0)
273 GOTO 90
274 ENDIF
275C
276 200 CONTINUE
277C-----------
278 CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1,prmod=msg_print)
279C-------------------------------------
280C Recherche des ID doubles
281C-------------------------------------
282 ids = 79
283 i = 0
284 j = 0
285 CALL vdouble(ixtg(nixtg,1),nixtg,numeltg0,mess,0,bid)
286 ids = 44
287C
288 RETURN
289 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:42
message_mod
Definition message_mod.F:1249
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
submodel_mod::submodel_data
Definition submodel_mod.F:723