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!|| nintrn ../starter/source/system/nintrn.F
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_spring(IXR ,ITAB ,ITABM1,IPART,IPARTR,
39 . IGEO ,IXR_KJ ,LSUBMODEL,ISKN,R_SKEW,IPM)
40C-----------------------------------------------
41C ROUTINE DESCRIPTION :
42C ===================
43C READ /SPRING ELEMENTS USING HM_READER
44C-----------------------------------------------
45C DUMMY ARGUMENTS DESCRIPTION:
46C ===================
47C
48C NAME DESCRIPTION
49C
50C IXR SPRING ELEM ARRAY : CONNECTIVITY, ID, PID
51C ITAB USER ID OF NODES
52C ITABM1 REVERSE TAB ITAB
53C IPART PART ARRAY
54C IPARTR INTERNAL PART ID OF A GIVEN SPRING ELEMENT
55C IGEO PROP ARRAY (INTEGER)
56C IXR_KJ KJOINT ADDITIONAL CONNECTIVITY
57C LSUBMODEL SUBMODEL STRUCTURE
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE message_mod
62 USE submodel_mod , ONLY : nsubmod, submodel_data
63 USE reader_old_mod , ONLY : line
64 USE user_id_mod , ONLY : id_limit
65C----------------------------------------------------------
66C LECTURE ELEMENT RESSORT
67C VERSION NUMEROTATION DES NOEUDS 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,ID,IDS,J,IPID,JC,STAT,IMID,IGTYP,MID
105 INTEGER FLAG_FMT,FLAG_FMT_TMP,IFIX_TMP
106 INTEGER FLAG_KJ(NUMELR),IKJ_TMP(3,NUMELR),NUMEL_KJ,CPT,
107 . index_part
108 CHARACTER MESS*40, MESS2*40, CHAR_MAT*11, CHAR_SKEW*11
109 my_real
110 . bid
111 INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_SPRING,SKEWID
112C-----------------------------------------------
113C E x t e r n a l F u n c t i o n s
114C-----------------------------------------------
115 INTEGER NINTRN
116 INTEGER USR2SYS
117 DATA mess /'3d spring elements definition '/
118 DATA MESS2/'3d spring elements selection for th plot'/
119C=======================================================================
120C--------------------------------------------------
121C ALLOCS & INITS
122C--------------------------------------------------
123 ALLOCATE (SUB_SPRING(NUMELR),STAT=stat)
124 IF (STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
125 . MSGTYPE=MSGERROR,
126 . C1='sub_spring')
127 SUB_SPRING(1:NUMELR) = 0
128 ALLOCATE (SKEWID(NUMELR),STAT=stat)
129 IF (STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
130 . MSGTYPE=MSGERROR,
131 . C1='skewid')
132 SKEWID(1:NUMELR) = 0
133 INDEX_PART = 1
134C--------------------------------------------------
135C READING SPRING INPUTS IN HM STRUCTURE
136C--------------------------------------------------
137 CALL CPP_SPRING_READ(IXR,NIXR,IXR_KJ,5,IPARTR,SUB_SPRING,SKEWID)
138C--------------------------------------------------
139C FILL OTHER STRUCTURES + CHECKS
140C--------------------------------------------------
141 I=0
142 NUMEL_KJ = 0
143C
144 DO N=1,NUMELR
145 I = I + 1
146C--------------------------------------------------
147C INTERNAL PART ID
148C--------------------------------------------------
149 IF( IPART(4,INDEX_PART) /= IPARTR(I) )THEN
150 DO J=1,NPART
151 IF(IPART(4,J)== IPARTR(I) ) INDEX_PART = J
152 ENDDO
153 ENDIF
154 IF( IPART(4,INDEX_PART) /= IPARTR(I) ) THEN
155 CALL ANCMSG(MSGID=402,
156 . MSGTYPE=MSGERROR,
157 . ANMODE=ANINFO_BLIND_1,
158 . C1="SPRING",
159 . I1=IPARTR(I),
160 . I2=IPARTR(I),
161 . PRMOD=MSG_CUMU)
162 ENDIF
163 IPID=IPART(2,INDEX_PART)
164 IMID=IPART(1,INDEX_PART)
165 IGTYP=IGEO(11,IPID)
166 IXR(5,I)=0
167C
168 IF(IGTYP == 23) IXR(5,I)=IMID
169 IPARTR(I) = INDEX_PART
170C--------------------------------------------------
171c
172 FLAG_KJ(I) = 0
173 DO J=1,3
174 IF (IXR_KJ(J,I)/=0) FLAG_KJ(I) = FLAG_KJ(I) + 1
175 END DO
176c
177 IF (IXR(NIXR,I)>ID_LIMIT%GLOBAL) THEN
178 CALL ANCMSG(MSGID=509,ANMODE=ANINFO,MSGTYPE=MSGERROR,
179 . I1=IXR(NIXR,I),C1=LINE,C2='/spring')
180 ENDIF
181 IXR(1,I)=IPID
182 IXR(2,I)=USR2SYS(IXR(2,I),ITABM1,MESS,IXR(NIXR,I))
183 IXR(3,I)=USR2SYS(IXR(3,I),ITABM1,MESS,IXR(NIXR,I))
184 CALL ANODSET(IXR(2,I), CHECK_SPRING)
185 CALL ANODSET(IXR(3,I), CHECK_SPRING)
186 IF(IXR(4,I)/=0) THEN
187 IXR(4,I)=USR2SYS(IXR(4,I),ITABM1,MESS,IXR(NIXR,I))
188 CALL ANODSET(IXR(4,I), CHECK_USED)
189 ENDIF
190C Noeuds additionels pour joints
191 IF (FLAG_KJ(I)>0) THEN
192 DO J=1,3
193 IF(IXR_KJ(J,I)/=0) THEN
194 IXR_KJ(J,I)=USR2SYS(IXR_KJ(J,I),ITABM1,MESS,IXR(NIXR,I))
195 CALL ANODSET(IXR_KJ(J,I), CHECK_USED)
196 ENDIF
197 END DO
198 ENDIF
199C Skews per element - PROP type23 and mat law 108 or PROP type8 - only
200 IF (SKEWID(I) > 0) THEN
201 DO J = 0,NUMSKW+MIN(1,NSPCOND)*NUMSPH+NSUBMOD
202 IF (SKEWID(I) == ISKN(4,J+1)) THEN
203 R_SKEW(I) = J+1
204 GO TO 500
205 ENDIF
206 ENDDO
207 CALL ANCMSG(MSGID=137,ANMODE=ANINFO,MSGTYPE=MSGERROR,
208 . C1='spring',
209 . C2='spring',
210 . I1=IXR(NIXR,I),I2=SKEWID(I))
211500 CONTINUE
212 ENDIF
213 ENDDO
214C
215 IF(ALLOCATED(SUB_SPRING)) DEALLOCATE(SUB_SPRING)
216C-----------
217 CALL ANCMSG(MSGID=402,
218 . MSGTYPE=MSGERROR,
219 . ANMODE=ANINFO_BLIND_1,
220 . PRMOD=MSG_PRINT)
221C-------------------------------------
222C Recherche des ID doubles
223C-------------------------------------
224 IDS = 79
225 I = 0
226 J = 0
227 CALL VDOUBLE(IXR(NIXR,1),NIXR,NUMELR,MESS,0,BID)
228 IDS = 35
229C
230 I1=1
231 I2=MIN0(50,NUMELR)
232C
233 90 WRITE (IOUT,300)
234 DO 100 I=I1,I2
235 PID = IGEO(1,IXR(1,I))
236C
237 IF (IXR(5,I) > 0) THEN
238 MID = IPM(1,IXR(5,I))
239 WRITE (CHAR_MAT,'(i10,1x)') MID
240 ELSE
241 CHAR_MAT=''
242 ENDIF
243C
244 IF (SKEWID(I) > 0) THEN
245 WRITE (CHAR_SKEW,'(i10)') SKEWID(I)
246 ELSE
247 CHAR_SKEW=''
248 ENDIF
249C
250 IF (IGEO(11,IXR(1,I))==45) NUMEL_KJ = NUMEL_KJ + 1
251 IF(IXR(4,I)==0) THEN
252 WRITE (IOUT,'(5(i10,1x),44x,a,a)') I,IXR(NIXR,I),PID,
253 . ITAB(IXR(2,I)),ITAB(IXR(3,I)),CHAR_MAT,CHAR_SKEW
254 ELSEIF (FLAG_KJ(I)>0) THEN
255 IF (FLAG_KJ(I) == 1) THEN
256 WRITE (IOUT,'(7(i10,1x),a,a)') I,IXR(NIXR,I),PID,
257 . ITAB(IXR(2,I)),ITAB(IXR(3,I)),ITAB(IXR(4,I)),
258 . (ITAB(IXR_KJ(J,I)),J=1,FLAG_KJ(I)),CHAR_MAT,CHAR_SKEW
259 ELSEIF (FLAG_KJ(I) == 2) THEN
260 WRITE (IOUT,'(8(i10,1x),a,a)') I,IXR(NIXR,I),PID,
261 . ITAB(IXR(2,I)),ITAB(IXR(3,I)),ITAB(IXR(4,I)),
262 . (ITAB(IXR_KJ(J,I)),J=1,FLAG_KJ(I)),CHAR_MAT,CHAR_SKEW
263 ELSEIF (FLAG_KJ(I) == 3) THEN
264 WRITE (IOUT,'(9(i10,1x),a,a)') I,IXR(NIXR,I),PID,
265 . ITAB(IXR(2,I)),ITAB(IXR(3,I)),ITAB(IXR(4,I)),
266 . (ITAB(IXR_KJ(J,I)),J=1,FLAG_KJ(I)),CHAR_MAT,CHAR_SKEW
267 ENDIF
268 ELSE
269 WRITE (IOUT,'(6(i10,1x),33x,a,a)') I,IXR(NIXR,I),PID,
270 . ITAB(IXR(2,I)),ITAB(IXR(3,I)),ITAB(IXR(4,I)),CHAR_MAT,CHAR_SKEW
271 ENDIF
272C
273 100 CONTINUE
274 IF(I2==NUMELR)GOTO 200
275 I1=I1+50
276 I2=MIN0(I2+50,NUMELR)
277 GOTO 90
278C
279C
280 200 CONTINUE
281C--------------------------------------------------
282C Reorganisation du tableau additionel pour kjoints
283C--------------------------------------------------
284
285 IF (NUMEL_KJ>0) THEN
286 DO I=1,NUMELR
287 DO J=1,3
288 IKJ_TMP(J,I)=IXR_KJ(J,I)
289 END DO
290 END DO
291 CPT = 0
292 IXR_KJ(1,NUMELR+1)=NUMEL_KJ
293 DO I=1,NUMELR
294 IF (IGEO(11,IXR(1,I))==45) THEN
295 CPT = CPT+1
296 DO J=1,3
297 IXR_KJ(J,CPT)=IKJ_TMP(J,I)
298 END DO
299 IXR_KJ(4,CPT)=IXR(NIXR,I)
300 IXR_KJ(5,CPT)=I
301 ENDIF
302 END DO
303 ENDIF
304C
305C----
306 RETURN
307 300 FORMAT(/' spring elements'/
308 + ' ---------------'/
309 + ' loc-el glo-el geom node1 node2'
310 + ' (node3) (mat_id) (skew)')
311 310 FORMAT(' spring element th selection'/
312 + ' ---------------------------'/)
313 RETURN
314 END
my_real
#define my_real
Definition cppsort.cpp:32
geom
subroutine geom(a, b, c, center_x, center_y, center_z, vol)
Definition geom.F:30
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:40
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
message_mod
Definition message_mod.F:1249
submodel_mod
Definition submodel_mod.F:712
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
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
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723