OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_spring.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_spring ../starter/source/elements/reader/hm_read_spring.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!|| usr2sys ../starter/source/system/sysfus.F
31!|| vdouble ../starter/source/system/sysfus.F
32!||--- uses -----------------------------------------------------
33!|| message_mod ../starter/share/message_module/message_mod.F
34!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
35!|| submodel_mod ../starter/share/modules1/submodel_mod.F
36!||====================================================================
37 SUBROUTINE hm_read_spring(IXR ,ITAB ,ITABM1,IPART,IPARTR,
38 . IGEO ,IXR_KJ ,LSUBMODEL,ISKN,R_SKEW,IPM)
39C-----------------------------------------------
40C ROUTINE DESCRIPTION :
41C ===================
42C READ /SPRING ELEMENTS USING HM_READER
43C-----------------------------------------------
44C DUMMY ARGUMENTS DESCRIPTION:
45C ===================
46C
47C NAME DESCRIPTION
48C
49C IXR SPRING ELEM ARRAY : CONNECTIVITY, ID, PID
50C ITAB USER ID OF NODES
51C ITABM1 REVERSE TAB ITAB
52C IPART PART ARRAY
53C IPARTR INTERNAL PART ID OF A GIVEN SPRING ELEMENT
54C IGEO PROP ARRAY (INTEGER)
55C IXR_KJ KJOINT ADDITIONAL CONNECTIVITY
56C LSUBMODEL SUBMODEL STRUCTURE
57C-----------------------------------------------
58C M o d u l e s
59C-----------------------------------------------
60 USE message_mod
61 USE submodel_mod , ONLY : nsubmod, submodel_data
62 USE reader_old_mod , ONLY : line
63 USE user_id_mod , ONLY : id_limit
64 use element_mod , only : nixr
65C----------------------------------------------------------
66C READING ELEMENT RESSORT
67C VERSION NUMEROTATION DES NODES LIBRE/MARS 90/DIM
68C----------------------------------------------------------
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 "units_c.inc"
83#include "param_c.inc"
84#include "sphcom.inc"
85C-----------------------------------------------
86C D u m m y A r g u m e n t s
87C-----------------------------------------------
88C INPUT ARGUMENTS
89 INTEGER,INTENT(IN)::ITAB(*)
90 INTEGER,INTENT(IN)::ITABM1(*)
91 INTEGER,INTENT(IN)::IPART(LIPART1,*)
92 INTEGER,INTENT(IN)::IGEO(NPROPGI,*)
93 INTEGER,INTENT(IN)::ISKN(LISKN,*)
94 INTEGER,INTENT(IN)::IPM(NPROPMI,*)
95 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(NSUBMOD)
96C OUTPUT ARGUMENTS
97 INTEGER,INTENT(OUT)::IXR(NIXR,*)
98 INTEGER,INTENT(OUT)::IXR_KJ(5,*)
99 INTEGER,INTENT(OUT)::IPARTR(*)
100 INTEGER,INTENT(OUT)::R_SKEW(*)
101C-----------------------------------------------
102C L o c a l V a r i a b l e s
103C-----------------------------------------------
104 INTEGER I, I1, I2,PID,N,IDS,J,IPID,STAT,IMID,IGTYP,MID
105 INTEGER FLAG_KJ(NUMELR),IKJ_TMP(3,NUMELR),NUMEL_KJ,CPT,
106 . index_part
107 CHARACTER MESS*40, MESS2*40, CHAR_MAT*11, CHAR_SKEW*11
108 my_real
109 . bid
110 INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_SPRING,SKEWID
111C-----------------------------------------------
112C E x t e r n a l F u n c t i o n s
113C-----------------------------------------------
114 INTEGER USR2SYS
115 DATA mess /'3D SPRING ELEMENTS DEFINITION '/
116 DATA mess2/'3D SPRING ELEMENTS SELECTION FOR TH PLOT'/
117C=======================================================================
118C--------------------------------------------------
119C ALLOCS & INITS
120C--------------------------------------------------
121 ALLOCATE (sub_spring(numelr),stat=stat)
122 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
123 . msgtype=msgerror,
124 . c1='SUB_SPRING')
125 sub_spring(1:numelr) = 0
126 ALLOCATE (skewid(numelr),stat=stat)
127 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
128 . msgtype=msgerror,
129 . c1='SKEWID')
130 skewid(1:numelr) = 0
131 index_part = 1
132C--------------------------------------------------
133C READING SPRING INPUTS IN HM STRUCTURE
134C--------------------------------------------------
135 CALL cpp_spring_read(ixr,nixr,ixr_kj,5,ipartr,sub_spring,skewid)
136C--------------------------------------------------
137C FILL OTHER STRUCTURES + CHECKS
138C--------------------------------------------------
139 i=0
140 numel_kj = 0
141C
142 DO n=1,numelr
143 i = i + 1
144C--------------------------------------------------
145C INTERNAL PART ID
146C--------------------------------------------------
147 IF( ipart(4,index_part) /= ipartr(i) )THEN
148 DO j=1,npart
149 IF(ipart(4,j)== ipartr(i) ) index_part = j
150 ENDDO
151 ENDIF
152 IF( ipart(4,index_part) /= ipartr(i) ) THEN
153 CALL ancmsg(msgid=402,
154 . msgtype=msgerror,
155 . anmode=aninfo_blind_1,
156 . c1="SPRING",
157 . i1=ipartr(i),
158 . i2=ipartr(i),
159 . prmod=msg_cumu)
160 ENDIF
161 ipid=ipart(2,index_part)
162 imid=ipart(1,index_part)
163 igtyp=igeo(11,ipid)
164 ixr(5,i)=0
165C
166 IF(igtyp == 23) ixr(5,i)=imid
167 ipartr(i) = index_part
168C--------------------------------------------------
169c
170 flag_kj(i) = 0
171 DO j=1,3
172 IF (ixr_kj(j,i)/=0) flag_kj(i) = flag_kj(i) + 1
173 END DO
174c
175 IF (ixr(nixr,i)>id_limit%GLOBAL) THEN
176 CALL ancmsg(msgid=509,anmode=aninfo,msgtype=msgerror,
177 . i1=ixr(nixr,i),c1=line,c2='/SPRING')
178 ENDIF
179 ixr(1,i)=ipid
180 ixr(2,i)=usr2sys(ixr(2,i),itabm1,mess,ixr(nixr,i))
181 ixr(3,i)=usr2sys(ixr(3,i),itabm1,mess,ixr(nixr,i))
182 CALL anodset(ixr(2,i), check_spring)
183 CALL anodset(ixr(3,i), check_spring)
184 IF(ixr(4,i)/=0) THEN
185 ixr(4,i)=usr2sys(ixr(4,i),itabm1,mess,ixr(nixr,i))
186 CALL anodset(ixr(4,i), check_used)
187 ENDIF
188C Additional nodes for joints
189 IF (flag_kj(i)>0) THEN
190 DO j=1,3
191 IF(ixr_kj(j,i)/=0) THEN
192 ixr_kj(j,i)=usr2sys(ixr_kj(j,i),itabm1,mess,ixr(nixr,i))
193 CALL anodset(ixr_kj(j,i), check_used)
194 ENDIF
195 END DO
196 ENDIF
197C Skews per element - PROP type23 and mat law 108 or PROP type8 - only
198 IF (skewid(i) > 0) THEN
199 DO j = 0,numskw+min(1,nspcond)*numsph+nsubmod
200 IF (skewid(i) == iskn(4,j+1)) THEN
201 r_skew(i) = j+1
202 GO TO 500
203 ENDIF
204 ENDDO
205 CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
206 . c1='SPRING',
207 . c2='SPRING',
208 . i1=ixr(nixr,i),i2=skewid(i))
209500 CONTINUE
210 ENDIF
211 ENDDO
212C
213 IF(ALLOCATED(sub_spring)) DEALLOCATE(sub_spring)
214C-----------
215 CALL ancmsg(msgid=402,
216 . msgtype=msgerror,
217 . anmode=aninfo_blind_1,
218 . prmod=msg_print)
219C-------------------------------------
220C Search for double IDs
221C-------------------------------------
222 ids = 79
223 i = 0
224 j = 0
225 CALL vdouble(ixr(nixr,1),nixr,numelr,mess,0,bid)
226 ids = 35
227C
228 i1=1
229 i2=min0(50,numelr)
230C
231 90 WRITE (iout,300)
232 DO 100 i=i1,i2
233 pid = igeo(1,ixr(1,i))
234C
235 IF (ixr(5,i) > 0) THEN
236 mid = ipm(1,ixr(5,i))
237 WRITE (char_mat,'(I10,1X)') mid
238 ELSE
239 char_mat=''
240 ENDIF
241C
242 IF (skewid(i) > 0) THEN
243 WRITE (char_skew,'(I10)') skewid(i)
244 ELSE
245 char_skew=''
246 ENDIF
247C
248 IF (igeo(11,ixr(1,i))==45) numel_kj = numel_kj + 1
249 IF(ixr(4,i)==0) THEN
250 WRITE (iout,'(5(I10,1X),44X,A,A)') i,ixr(nixr,i),pid,
251 . itab(ixr(2,i)),itab(ixr(3,i)),char_mat,char_skew
252 ELSEIF (flag_kj(i)>0) THEN
253 IF (flag_kj(i) == 1) THEN
254 WRITE (iout,'(7(I10,1X),A,A)') i,ixr(nixr,i),pid,
255 . itab(ixr(2,i)),itab(ixr(3,i)),itab(ixr(4,i)),
256 . (itab(ixr_kj(j,i)),j=1,flag_kj(i)),char_mat,char_skew
257 ELSEIF (flag_kj(i) == 2) THEN
258 WRITE (iout,'(8(I10,1X),A,A)') i,ixr(nixr,i),pid,
259 . itab(ixr(2,i)),itab(ixr(3,i)),itab(ixr(4,i)),
260 . (itab(ixr_kj(j,i)),j=1,flag_kj(i)),char_mat,char_skew
261 ELSEIF (flag_kj(i) == 3) THEN
262 WRITE (iout,'(9(I10,1X),A,A)') i,ixr(nixr,i),pid,
263 . itab(ixr(2,i)),itab(ixr(3,i)),itab(ixr(4,i)),
264 . (itab(ixr_kj(j,i)),j=1,flag_kj(i)),char_mat,char_skew
265 ENDIF
266 ELSE
267 WRITE (iout,'(6(I10,1X),33X,A,A)') i,ixr(nixr,i),pid,
268 . itab(ixr(2,i)),itab(ixr(3,i)),itab(ixr(4,i)),char_mat,char_skew
269 ENDIF
270C
271 100 CONTINUE
272 IF(i2==numelr)GOTO 200
273 i1=i1+50
274 i2=min0(i2+50,numelr)
275 GOTO 90
276C
277C
278 200 CONTINUE
279C--------------------------------------------------
280C Reorganization of the additional table for kjoints
281C--------------------------------------------------
282
283 IF (numel_kj>0) THEN
284 DO i=1,numelr
285 DO j=1,3
286 ikj_tmp(j,i)=ixr_kj(j,i)
287 END DO
288 END DO
289 cpt = 0
290 ixr_kj(1,numelr+1)=numel_kj
291 DO i=1,numelr
292 IF (igeo(11,ixr(1,i))==45) THEN
293 cpt = cpt+1
294 DO j=1,3
295 ixr_kj(j,cpt)=ikj_tmp(j,i)
296 END DO
297 ixr_kj(4,cpt)=ixr(nixr,i)
298 ixr_kj(5,cpt)=i
299 ENDIF
300 END DO
301 ENDIF
302C
303C----
304 RETURN
305 300 FORMAT(/' SPRING ELEMENTS'/
306 + ' ---------------'/
307 + ' LOC-EL GLO-EL GEOM NODE1 NODE2'
308 + ' (NODE3) (MAT_ID) (SKEW)')
309 RETURN
310 END
anodset
void anodset(int *id, int *type)
Definition analyse_node.c:321
my_real
#define my_real
Definition cppsort.cpp:32
hm_read_spring
subroutine hm_read_spring(ixr, itab, itabm1, ipart, ipartr, igeo, ixr_kj, lsubmodel, iskn, r_skew, ipm)
Definition hm_read_spring.F:39
min
#define min(a, b)
Definition macros.h:20
message_mod
Definition message_mod.F:1257
submodel_mod
Definition submodel_mod.F:717
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725
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
submodel_mod::submodel_data
Definition submodel_mod.F:728