OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop44.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_prop44 ../starter/source/properties/spring/hm_read_prop44.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_prop_generic ../starter/source/properties/hm_read_prop_generic.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
30!|| hm_get_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
31!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
32!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
33!|| set_u_geo ../starter/source/user_interface/uaccess.F
34!|| set_u_pnu ../starter/source/user_interface/uaccess.F
35!||--- uses -----------------------------------------------------
36!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
37!|| message_mod ../starter/share/message_module/message_mod.F
38!|| submodel_mod ../starter/share/modules1/submodel_mod.F
39!||====================================================================
40 SUBROUTINE hm_read_prop44(IOUT ,IG ,NUVAR ,PARGEO,
41 . UNITAB,ISKN ,IGEO ,TITR ,IGTYP ,
42 . PROP_TAG,LSUBMODEL ,SUB_ID)
43C-----------------------------------------------
44 USE unitab_mod
45 USE message_mod
46 USE elbuftag_mod
47 USE submodel_mod
49C----------+---------+---+---+--------------------------------------------
50C Crushable frame spring property (old uer type spring)
51C----------+---------+---+---+--------------------------------------------
52C VAR | SIZE |TYP| RW| DEFINITION
53C----------+---------+---+---+--------------------------------------------
54C IOUT | 1 | I | R | OUTPUT FILE UNIT (L00 file)
55C IG | 1 | I | R | PROPERTY NUMBER
56C NUVAR | 1 | I | W | NUMBER OF USER ELEMENT VARIABLES
57C----------+---------+---+---+--------------------------------------------
58C PARGEO | * | F | W | 1)SKEW NUMBER
59C | | | | 2)STIFNESS FOR INTERFACE
60C | | | | 3)FRONT WAVE OPTION
61C | | | | 4)... not yet used
62C-----------------------------------------------
63C I m p l i c i t T y p e s
64C-----------------------------------------------
65#include "implicit_f.inc"
66C-----------------------------------------------
67C C o m m o n B l o c k s
68C-----------------------------------------------
69#include "com04_c.inc"
70#include "param_c.inc"
71#include "sphcom.inc"
72#include "tablen_c.inc"
73C----------+---------+---+---+--------------------------------------------
74C D u m m y A r g u m e n t s
75C-----------------------------------------------
76 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
77 INTEGER IOUT,IG,NUVAR,IGEO(NPROPGI),ISKN(LISKN,*),
78 . igtyp,sub_id
79 my_real
80 . pargeo(*)
81 TYPE(prop_tag_) , DIMENSION(0:MAXPROP) :: PROP_TAG
82 CHARACTER(LEN=NCHARTITLE) :: TITR
83 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
84C-----------------------------------------------
85C L o c a l V a r i a b l e s
86C-----------------------------------------------
87 INTEGER IERROR,ISK,
88 . IFUN_XP,IFUN_XMI,IFUN_XXPI,IFUN_XXMI,IFUN_YY1PI,
89 . ifun_yy1mi,ifun_yy2pi,ifun_yy2mi,ifun_zz1pi,
90 . ifun_zz1mi,ifun_zz2pi,ifun_zz2mi,
91 . ifun_xmr,ifun_xxpr,ifun_xxmr,ifun_yy1pr,
92 . ifun_yy1mr,ifun_yy2pr,ifun_yy2mr,ifun_zz1pr,
93 . ifun_zz1mr,ifun_zz2pr,ifun_zz2mr,ico,k,
94 . ifun_damp_x,ifun_damp_y,ifun_damp_z,ifun_damp_xx,
95 . ifun_damp_yy,ifun_damp_zz,nc_filter,idamp
96 my_real
97 . fscal_x,fscal_rx,fscal_ry1,fscal_ry2 ,fscal_rz1,fscal_rz2,
98 . amas,iner,xk,xco,k11,k44,k55,k66,k5b,k6c,
99 . xlimg,xlim,xxlim,yy1lim,yy2lim,zz1lim,zz2lim,
100 . fscal_damp_x,fscal_damp_y,fscal_damp_z,
101 . fscal_damp_xx,fscal_damp_yy,fscal_damp_zz,
102 . f_x,f_y,f_z,f_xx,f_yy,f_zz,rnc_filter,rdamp,
103 . fscal_x_dim,fscal_rx_dim,fscal_ry1_dim,
104 . fscal_ry2_dim,fscal_rz1_dim,fscal_rz2_dim,
105 . iner_dim,
106 . fscal_damp_x_dim,fscal_damp_y_dim,fscal_damp_z_dim,
107 . fscal_damp_xx_dim,fscal_damp_yy_dim,fscal_damp_zz_dim,
108 . f_x_dim,f_y_dim,f_z_dim,f_xx_dim,f_yy_dim,f_zz_dim
109 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
110C-----------------------------------------------
111 INTEGER KFUNC
112 PARAMETER (KFUNC=29)
113C-----------------------------------------------
114C E x t e r n a l F u n c t i o n s
115C-----------------------------------------------
116 INTEGER SET_U_PNU,SET_U_GEO
117 EXTERNAL SET_U_PNU,SET_U_GEO
118C=======================================================================
119C
120 is_encrypted = .false.
121 is_available = .false.
122C--------------------------------------------------
123C EXTRACT DATA (IS OPTION CRYPTED)
124C--------------------------------------------------
125 CALL hm_option_is_encrypted(is_encrypted)
126C--------------------------------------------------
127C
128 nuvar = 42 ! damping (linear or function) + strain rate filtering
129 rnc_filter = zero
130 idamp = 0
131 rdamp = zero
132 ifun_damp_x = 0
133 ifun_damp_y = 0
134 ifun_damp_z = 0
135 ifun_damp_xx = 0
136 ifun_damp_yy = 0
137 ifun_damp_zz = 0
138 fscal_damp_x = 0
139 fscal_damp_y = 0
140 fscal_damp_z = 0
141 fscal_damp_xx = zero
142 fscal_damp_yy = zero
143 fscal_damp_zz = zero
144 f_x = zero
145 f_y = zero
146 f_z = zero
147 f_xx = zero
148 f_yy = zero
149 f_zz = zero
150C
151Card1
152C--------------------------------------------------
153C EXTRACT DATAS (INTEGER VALUES)
154C--------------------------------------------------
155 CALL hm_get_intv('SKEW_CSID',isk,is_available,lsubmodel)
156 IF(isk == 0 .AND. sub_id /= 0 ) isk = lsubmodel(sub_id)%SKEW
157 CALL hm_get_intv('Icoupling',ico,is_available,lsubmodel)
158 CALL hm_get_intv('Ifiltr',nc_filter,is_available,lsubmodel)
159C--------------------------------------------------
160C EXTRACT DATAS (REAL VALUES)
161C--------------------------------------------------
162 CALL hm_get_floatv('MASS',amas,is_available,lsubmodel,unitab)
163 CALL hm_get_floatv('INERTIA',iner,is_available,lsubmodel,unitab)
164 CALL hm_get_floatv_dim('INERTIA',iner_dim,is_available,lsubmodel,unitab)
165 CALL hm_get_floatv('STIFF1',xk,is_available,lsubmodel,unitab)
166Card2 - stiffness in traction, torsion, flex_y, flex_z
167C--------------------------------------------------
168C EXTRACT DATAS (INTEGER VALUES)
169C--------------------------------------------------
170 CALL hm_get_intv('IDAMP',idamp,is_available,lsubmodel)
171C--------------------------------------------------
172C EXTRACT DATAS (REAL VALUES)
173C--------------------------------------------------
174 CALL hm_get_floatv('K11',k11,is_available,lsubmodel,unitab)
175 CALL hm_get_floatv('K44',k44,is_available,lsubmodel,unitab)
176 CALL hm_get_floatv('K55',k55,is_available,lsubmodel,unitab)
177 CALL hm_get_floatv('K66',k66,is_available,lsubmodel,unitab)
178Card3 stiffness in flexion yy and zz (off diagonal)
179C--------------------------------------------------
180C EXTRACT DATAS (REAL VALUES)
181C--------------------------------------------------
182 CALL hm_get_floatv('K5b',k5b,is_available,lsubmodel,unitab)
183 CALL hm_get_floatv('K6c',k6c,is_available,lsubmodel,unitab)
184Card4 trans_x (traction)
185C--------------------------------------------------
186C EXTRACT DATAS (INTEGER VALUES)
187C--------------------------------------------------
188 CALL hm_get_intv('FUN_A1',ifun_xp,is_available,lsubmodel)
189 CALL hm_get_intv('FUN_B1',ifun_xmi,is_available,lsubmodel)
190 CALL hm_get_intv('FUN_A2',ifun_xmr,is_available,lsubmodel)
191C--------------------------------------------------
192C EXTRACT DATAS (REAL VALUES)
193C--------------------------------------------------
194 CALL hm_get_floatv('FScale11',fscal_x,is_available,lsubmodel,unitab)
195 CALL hm_get_floatv_dim('FScale11',fscal_x_dim,is_available,lsubmodel,unitab)
196Card5 rot_x (torsion)
197C--------------------------------------------------
198C EXTRACT DATAS (INTEGER VALUES)
199C--------------------------------------------------
200 CALL hm_get_intv('FUN_B2',ifun_xxpi,is_available,lsubmodel)
201 CALL hm_get_intv('FUN_A3',ifun_xxmi,is_available,lsubmodel)
202 CALL hm_get_intv('FUN_B3',ifun_xxpr,is_available,lsubmodel)
203 CALL hm_get_intv('FUN_A4',ifun_xxmr,is_available,lsubmodel)
204C--------------------------------------------------
205C EXTRACT DATAS (REAL VALUES)
206C--------------------------------------------------
207 CALL hm_get_floatv('FScale22',fscal_rx,is_available,lsubmodel,unitab)
208 CALL hm_get_floatv_dim('FScale22',fscal_rx_dim,is_available,lsubmodel,unitab)
209Card6 rot_y1 (flexion, torsion)
210C--------------------------------------------------
211C EXTRACT DATAS (INTEGER VALUES)
212C--------------------------------------------------
213 CALL hm_get_intv('FUN_B4',ifun_yy1pi,is_available,lsubmodel)
214 CALL hm_get_intv('FUN_A5',ifun_yy1mi,is_available,lsubmodel)
215 CALL hm_get_intv('FUN_B5',ifun_yy1pr,is_available,lsubmodel)
216 CALL hm_get_intv('FUN_A6',ifun_yy1mr,is_available,lsubmodel)
217C--------------------------------------------------
218C EXTRACT DATAS (REAL VALUES)
219C--------------------------------------------------
220 CALL hm_get_floatv('FScale33',fscal_ry1,is_available,lsubmodel,unitab)
221 CALL hm_get_floatv_dim('FScale33',fscal_ry1_dim,is_available,lsubmodel,unitab)
222Card7 rot_z1 (flexion, torsion)
223C--------------------------------------------------
224C EXTRACT DATAS (INTEGER VALUES)
225C--------------------------------------------------
226 CALL hm_get_intv('FUN_B6',ifun_zz1pi,is_available,lsubmodel)
227 CALL hm_get_intv('FUN_C1',ifun_zz1mi,is_available,lsubmodel)
228 CALL hm_get_intv('FUN_C2',ifun_zz1pr,is_available,lsubmodel)
229 CALL hm_get_intv('FUN_C3',ifun_zz1mr,is_available,lsubmodel)
230C--------------------------------------------------
231C EXTRACT DATAS (REAL VALUES)
232C--------------------------------------------------
233 CALL hm_get_floatv('FScale12',fscal_rz1,is_available,lsubmodel,unitab)
234 CALL hm_get_floatv_dim('FScale12',fscal_rz1_dim,is_available,lsubmodel,unitab)
235Card8 rot_y2 (flexion, torsion)
236C--------------------------------------------------
237C EXTRACT DATAS (INTEGER VALUES)
238C--------------------------------------------------
239 CALL hm_get_intv('FUN_C4',ifun_yy2pi,is_available,lsubmodel)
240 CALL hm_get_intv('FUN_C5',ifun_yy2mi,is_available,lsubmodel)
241 CALL hm_get_intv('FUN_C6',ifun_yy2pr,is_available,lsubmodel)
242 CALL hm_get_intv('FUN_D1',ifun_yy2mr,is_available,lsubmodel)
243C--------------------------------------------------
244C EXTRACT DATAS (REAL VALUES)
245C--------------------------------------------------
246 CALL hm_get_floatv('fscale23',FSCAL_RY2,IS_AVAILABLE,LSUBMODEL,UNITAB)
247 CALL HM_GET_FLOATV_DIM('fscale23',FSCAL_RY2_DIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
248Card9 rot_z2 (flexion, torsion)
249C--------------------------------------------------
250C EXTRACT DATAS (INTEGER VALUES)
251C--------------------------------------------------
252 CALL HM_GET_INTV('fun_d2',IFUN_ZZ2PI,IS_AVAILABLE,LSUBMODEL)
253 CALL HM_GET_INTV('fun_d3',IFUN_ZZ2MI,IS_AVAILABLE,LSUBMODEL)
254 CALL HM_GET_INTV('fun_d4',IFUN_ZZ2PR,IS_AVAILABLE,LSUBMODEL)
255 CALL HM_GET_INTV('fun_d5',IFUN_ZZ2MR,IS_AVAILABLE,LSUBMODEL)
256C--------------------------------------------------
257C EXTRACT DATAS (REAL VALUES)
258C--------------------------------------------------
259 CALL HM_GET_FLOATV('fscale13',FSCAL_RZ2,IS_AVAILABLE,LSUBMODEL,UNITAB)
260 CALL HM_GET_FLOATV_DIM('fscale13',FSCAL_RZ2_DIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
261Card10
262C--------------------------------------------------
263C EXTRACT DATAS (REAL VALUES)
264C--------------------------------------------------
265 CALL HM_GET_FLOATV('strain1',XLIMG,IS_AVAILABLE,LSUBMODEL,UNITAB)
266 CALL HM_GET_FLOATV('strain2',XLIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
267 CALL HM_GET_FLOATV('strain3',XXLIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
268Card11
269C--------------------------------------------------
270C EXTRACT DATAS (REAL VALUES)
271C--------------------------------------------------
272 CALL HM_GET_FLOATV('strain4',YY1LIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
273 CALL HM_GET_FLOATV('strain5',ZZ1LIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
274 CALL HM_GET_FLOATV('strain6',YY2LIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
275 CALL HM_GET_FLOATV('strain7',ZZ2LIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
276!-----------------------------------------------------------------------
277 IF (IDAMP > 0) THEN
278Card12
279C--------------------------------------------------
280C EXTRACT DATAS (INTEGER VALUES)
281C--------------------------------------------------
282 CALL HM_GET_INTV('fct_d_x',IFUN_DAMP_X,IS_AVAILABLE,LSUBMODEL)
283C--------------------------------------------------
284C EXTRACT DATAS (REAL VALUES)
285C--------------------------------------------------
286 CALL HM_GET_FLOATV('dscale_x',FSCAL_DAMP_X,IS_AVAILABLE,LSUBMODEL,UNITAB)
287 CALL HM_GET_FLOATV('f_x',F_X,IS_AVAILABLE,LSUBMODEL,UNITAB)
288 CALL HM_GET_FLOATV_DIM('dscale_x',FSCAL_DAMP_X_DIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
289 CALL HM_GET_FLOATV_DIM('f_x',F_X_DIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
290Card13
291C--------------------------------------------------
292C EXTRACT DATAS (INTEGER VALUES)
293C--------------------------------------------------
294 CALL HM_GET_INTV('fct_d_y',IFUN_DAMP_Y,IS_AVAILABLE,LSUBMODEL)
295C--------------------------------------------------
296C EXTRACT DATAS (REAL VALUES)
297C--------------------------------------------------
298 CALL HM_GET_FLOATV('dscale_y',FSCAL_DAMP_Y,IS_AVAILABLE,LSUBMODEL,UNITAB)
299 CALL HM_GET_FLOATV('f_y',F_Y,IS_AVAILABLE,LSUBMODEL,UNITAB)
300 CALL HM_GET_FLOATV_DIM('dscale_y',FSCAL_DAMP_Y_DIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
301 CALL HM_GET_FLOATV_DIM('f_y',F_Y_DIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
302Card14
303C--------------------------------------------------
304C EXTRACT DATAS (INTEGER VALUES)
305C--------------------------------------------------
306 CALL HM_GET_INTV('fct_d_z',IFUN_DAMP_Z,IS_AVAILABLE,LSUBMODEL)
307C--------------------------------------------------
308C EXTRACT DATAS (REAL VALUES)
309C--------------------------------------------------
310 CALL HM_GET_FLOATV('dscale_z',FSCAL_DAMP_Z,IS_AVAILABLE,LSUBMODEL,UNITAB)
311 CALL HM_GET_FLOATV('f_z',F_Z,IS_AVAILABLE,LSUBMODEL,UNITAB)
312 CALL HM_GET_FLOATV_DIM('dscale_z',FSCAL_DAMP_Z_DIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
313 CALL HM_GET_FLOATV_DIM('f_z',F_Z_DIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
314Card15
315C--------------------------------------------------
316C EXTRACT DATAS (INTEGER VALUES)
317C--------------------------------------------------
318 CALL HM_GET_INTV('fct_d_xx',IFUN_DAMP_XX,IS_AVAILABLE,LSUBMODEL)
319C--------------------------------------------------
320C EXTRACT DATAS (REAL VALUES)
321C--------------------------------------------------
322 CALL HM_GET_FLOATV('dscale_xx',FSCAL_DAMP_XX,IS_AVAILABLE,LSUBMODEL,UNITAB)
323 CALL HM_GET_FLOATV('f_xx',F_XX,IS_AVAILABLE,LSUBMODEL,UNITAB)
324 CALL HM_GET_FLOATV_DIM('dscale_xx',FSCAL_DAMP_XX_DIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
325 CALL HM_GET_FLOATV_DIM('f_xx',F_XX_DIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
326Card16
327C--------------------------------------------------
328C EXTRACT DATAS (INTEGER VALUES)
329C--------------------------------------------------
330 CALL HM_GET_INTV('fct_d_yy',IFUN_DAMP_YY,IS_AVAILABLE,LSUBMODEL)
331C--------------------------------------------------
332C EXTRACT DATAS (REAL VALUES)
333C--------------------------------------------------
334 CALL HM_GET_FLOATV('dscale_yy',FSCAL_DAMP_YY,IS_AVAILABLE,LSUBMODEL,UNITAB)
335 CALL HM_GET_FLOATV('f_yy',F_YY,IS_AVAILABLE,LSUBMODEL,UNITAB)
336 CALL HM_GET_FLOATV_DIM('dscale_yy',FSCAL_DAMP_YY_DIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
337 CALL HM_GET_FLOATV_DIM('f_yy',F_YY_DIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
338Card17
339C--------------------------------------------------
340C EXTRACT DATAS (INTEGER VALUES)
341C--------------------------------------------------
342 CALL HM_GET_INTV('fct_d_zz',IFUN_DAMP_ZZ,IS_AVAILABLE,LSUBMODEL)
343C--------------------------------------------------
344C EXTRACT DATAS (REAL VALUES)
345C--------------------------------------------------
346 CALL HM_GET_FLOATV('dscale_zz',FSCAL_DAMP_ZZ,IS_AVAILABLE,LSUBMODEL,UNITAB)
347 CALL HM_GET_FLOATV('f_zz',F_ZZ,IS_AVAILABLE,LSUBMODEL,UNITAB)
348 CALL HM_GET_FLOATV_DIM('dscale_zz',FSCAL_DAMP_ZZ_DIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
349 CALL HM_GET_FLOATV_DIM('f_zz',F_ZZ_DIM,IS_AVAILABLE,LSUBMODEL,UNITAB)
350!
351 ENDIF ! IF (IDAMP > 0)
352!-----------------------------------------------------------------------
353 IF (FSCAL_X == ZERO) FSCAL_X = ONE * FSCAL_X_DIM
354 IF (FSCAL_RX == ZERO) FSCAL_RX = ONE * FSCAL_RX_DIM
355 IF (FSCAL_RY1 == ZERO) FSCAL_RY1 = ONE * FSCAL_RY1_DIM
356 IF (FSCAL_RY2 == ZERO) FSCAL_RY2 = ONE * FSCAL_RY2_DIM
357 IF (FSCAL_RZ1 == ZERO) FSCAL_RZ1 = ONE * FSCAL_RZ1_DIM
358 IF (FSCAL_RZ2 == ZERO) FSCAL_RZ2 = ONE * FSCAL_RZ2_DIM
359!
360 IF(INER < EM20) THEN
361 INER = EM20 * INER_DIM
362 CALL ANCMSG(MSGID=445,
363 . MSGTYPE=MSGWARNING,
364 . ANMODE=ANINFO_BLIND_1,
365 . I1=IG,
366 . C1=TITR)
367 ENDIF
368C--------------------------------------------
369! strain rate filtering (by default = 12 cycles):
370 IF (NC_FILTER > 0) NC_FILTER = 12
371C--------------------------------------------
372 DO K=0,NUMSKW+MIN(1,NSPCOND)*NUMSPH+NSUBMOD
373 IF(ISK == ISKN(4,K+1)) THEN
374 ISK=K+1
375 GO TO 100
376 ENDIF
377 ENDDO
378 CALL ANCMSG(MSGID=137,ANMODE=ANINFO,MSGTYPE=MSGERROR,
379 . C1='property',
380 . C2='property',
381 . I1=IGEO(1),I2=ISK,C3=TITR)
382100 CONTINUE
383 PARGEO(1) = ISK
384 PARGEO(2) = XK
385C front wave = 1
386 PARGEO(3) = 1
387C--------------------------------------------
388 IF (IFUN_XP <= 0)WRITE(IOUT,*)
389 . ' **error zero FUNCTION number x+'
390 IF (IFUN_XMI <= 0)WRITE(IOUT,*)
391 . ' **error zero function number xi-'
392 IF (IFUN_XXPI <= 0)WRITE(IOUT,*)
393 . ' **error zero function number xxi+'
394 IF (IFUN_XXMI <= 0)WRITE(IOUT,*)
395 . ' **error zero function number xxi-'
396 IF (IFUN_YY1PI <= 0)WRITE(IOUT,*)
397 . ' **error zero function number yy1i+'
398 IF (IFUN_YY1MI <= 0)WRITE(IOUT,*)
399 . ' **error zero function number yy1i-'
400!
401 IF (IDAMP > 0) THEN
402 IF (IFUN_DAMP_X <= 0)WRITE(IOUT,*)
403 . ' **error zero function number damp_x ---> linear damping is used'
404 IF (IFUN_DAMP_Y <= 0)WRITE(IOUT,*)
405 . ' **error zero function number damp_y ---> linear damping is used'
406 IF (IFUN_DAMP_Z <= 0)WRITE(IOUT,*)
407 . ' **error zero function number damp_z ---> linear damping is used'
408 IF (IFUN_DAMP_XX <= 0)WRITE(IOUT,*)
409 . ' **error zero function number damp_xx ---> linear damping is used'
410 IF (IFUN_DAMP_YY <= 0)WRITE(IOUT,*)
411 . ' **error zero function number damp_yy ---> linear damping is used'
412 IF (IFUN_DAMP_ZZ <= 0)WRITE(IOUT,*)
413 . ' **error zero function number damp_zz ---> linear damping is used'
414 ENDIF ! IF (IDAMP > 0)
415!
416 IF (IFUN_XMR <= 0)IFUN_XMR =IFUN_XMI
417 IF (IFUN_XXPR <= 0)IFUN_XXPR =IFUN_XXPI
418 IF (IFUN_XXMR <= 0)IFUN_XXMR =IFUN_XXMI
419 IF (IFUN_YY1PR <= 0)IFUN_YY1PR=IFUN_YY1PI
420 IF (IFUN_YY2PI <= 0)IFUN_YY2PI=IFUN_YY1PI
421 IF (IFUN_YY2PR <= 0)IFUN_YY2PR=IFUN_YY1PR
422 IF (IFUN_ZZ1PI <= 0)IFUN_ZZ1PI=IFUN_YY1PI
423 IF (IFUN_ZZ1PR <= 0)IFUN_ZZ1PR=IFUN_ZZ1PI
424 IF (IFUN_ZZ2PI <= 0)IFUN_ZZ2PI=IFUN_ZZ1PI
425 IF (IFUN_ZZ2PR <= 0)IFUN_ZZ2PR=IFUN_ZZ1PR
426 IF (IFUN_YY1MR <= 0)IFUN_YY1MR=IFUN_YY1MI
427 IF (IFUN_YY2MI <= 0)IFUN_YY2MI=IFUN_YY1MI
428 IF (IFUN_YY2MR <= 0)IFUN_YY2MR=IFUN_YY1MR
429 IF (IFUN_ZZ1MI <= 0)IFUN_ZZ1MI=IFUN_YY1MI
430 IF (IFUN_ZZ1MR <= 0)IFUN_ZZ1MR=IFUN_ZZ1MI
431 IF (IFUN_ZZ2MI <= 0)IFUN_ZZ2MI=IFUN_ZZ1MI
432 IF (IFUN_ZZ2MR <= 0)IFUN_ZZ2MR=IFUN_ZZ1MR
433C---
434 IERROR = SET_U_GEO(1,XLIMG)
435 IERROR = SET_U_GEO(2,XLIM)
436 IERROR = SET_U_GEO(3,XXLIM)
437 IERROR = SET_U_GEO(4,YY1LIM)
438 IERROR = SET_U_GEO(5,ZZ1LIM)
439 IERROR = SET_U_GEO(6,YY2LIM)
440 IERROR = SET_U_GEO(7,ZZ2LIM)
441 IERROR = SET_U_GEO(8,AMAS)
442 IERROR = SET_U_GEO(9,INER)
443 IERROR = SET_U_GEO(10,K11)
444 IERROR = SET_U_GEO(11,K44)
445 IERROR = SET_U_GEO(12,K55)
446 IERROR = SET_U_GEO(13,K66)
447 IERROR = SET_U_GEO(14,K5B)
448 IERROR = SET_U_GEO(15,K6C)
449 XCO = ICO
450 IERROR = SET_U_GEO(16,XCO)
451 IERROR = SET_U_GEO(17,FSCAL_X)
452 IERROR = SET_U_GEO(18,FSCAL_RX)
453 IERROR = SET_U_GEO(19,FSCAL_RY1)
454 IERROR = SET_U_GEO(20,FSCAL_RY2)
455 IERROR = SET_U_GEO(21,FSCAL_RZ1)
456 IERROR = SET_U_GEO(22,FSCAL_RZ2)
457C
458 IERROR = SET_U_PNU(1,IFUN_XMI,KFUNC)
459 IERROR = SET_U_PNU(2,IFUN_XXMI,KFUNC)
460 IERROR = SET_U_PNU(3,IFUN_YY1MI,KFUNC)
461 IERROR = SET_U_PNU(4,IFUN_ZZ1MI,KFUNC)
462 IERROR = SET_U_PNU(5,IFUN_YY2MI,KFUNC)
463 IERROR = SET_U_PNU(6,IFUN_ZZ2MI,KFUNC)
464 IERROR = SET_U_PNU(7,IFUN_XP,KFUNC)
465 IERROR = SET_U_PNU(8,IFUN_XXPI,KFUNC)
466 IERROR = SET_U_PNU(9,IFUN_YY1PI,KFUNC)
467
468 IERROR = SET_U_PNU(10,IFUN_ZZ1PI,KFUNC)
469 IERROR = SET_U_PNU(11,IFUN_YY2PI,KFUNC)
470 IERROR = SET_U_PNU(12,IFUN_ZZ2PI,KFUNC)
471 IERROR = SET_U_PNU(13,IFUN_XMR,KFUNC)
472 IERROR = SET_U_PNU(14,IFUN_XXMR,KFUNC)
473 IERROR = SET_U_PNU(15,IFUN_YY1MR,KFUNC)
474 IERROR = SET_U_PNU(16,IFUN_ZZ1MR,KFUNC)
475 IERROR = SET_U_PNU(17,IFUN_YY2MR,KFUNC)
476 IERROR = SET_U_PNU(18,IFUN_ZZ2MR,KFUNC)
477 IERROR = SET_U_PNU(19,IFUN_XXPR,KFUNC)
478 IERROR = SET_U_PNU(20,IFUN_YY1PR,KFUNC)
479 IERROR = SET_U_PNU(21,IFUN_ZZ1PR,KFUNC)
480 IERROR = SET_U_PNU(22,IFUN_YY2PR,KFUNC)
481 IERROR = SET_U_PNU(23,IFUN_ZZ2PR,KFUNC)
482!--------------------------------------------
483 IF (IDAMP > 0) THEN
484! function damping
485 IERROR = SET_U_PNU(24,IFUN_DAMP_X,KFUNC)
486 IERROR = SET_U_PNU(25,IFUN_DAMP_Y,KFUNC)
487 IERROR = SET_U_PNU(26,IFUN_DAMP_Z,KFUNC)
488 IERROR = SET_U_PNU(27,IFUN_DAMP_XX,KFUNC)
489 IERROR = SET_U_PNU(28,IFUN_DAMP_YY,KFUNC)
490 IERROR = SET_U_PNU(29,IFUN_DAMP_ZZ,KFUNC)
491! damping
492 IF (F_X == ZERO) F_X = ONE * F_X_DIM
493 IF (F_Y == ZERO) F_Y = ONE * F_Y_DIM
494 IF (F_Z == ZERO) F_Z = ONE * F_Z_DIM
495 IF (F_XX == ZERO) F_XX = ONE * F_XX_DIM
496 IF (F_YY == ZERO) F_YY = ONE * F_YY_DIM
497 IF (F_ZZ == ZERO) F_ZZ = ONE * F_ZZ_DIM
498!
499 IF (FSCAL_DAMP_X == ZERO) FSCAL_DAMP_X = ONE * FSCAL_DAMP_X_DIM
500 IF (FSCAL_DAMP_Y == ZERO) FSCAL_DAMP_Y = ONE * FSCAL_DAMP_Y_DIM
501 IF (FSCAL_DAMP_Z == ZERO) FSCAL_DAMP_Z = ONE * FSCAL_DAMP_Z_DIM
502 IF (FSCAL_DAMP_XX == ZERO) FSCAL_DAMP_XX = ONE * FSCAL_DAMP_XX_DIM
503 IF (FSCAL_DAMP_YY == ZERO) FSCAL_DAMP_YY = ONE * FSCAL_DAMP_YY_DIM
504 IF (FSCAL_DAMP_ZZ == ZERO) FSCAL_DAMP_ZZ = ONE * FSCAL_DAMP_ZZ_DIM
505!
506 IERROR = SET_U_GEO(23,FSCAL_DAMP_X)
507 IERROR = SET_U_GEO(24,FSCAL_DAMP_Y)
508 IERROR = SET_U_GEO(25,FSCAL_DAMP_Z)
509 IERROR = SET_U_GEO(26,FSCAL_DAMP_XX)
510 IERROR = SET_U_GEO(27,FSCAL_DAMP_YY)
511 IERROR = SET_U_GEO(28,FSCAL_DAMP_ZZ)
512!
513 IERROR = SET_U_GEO(29,F_X)
514 IERROR = SET_U_GEO(30,F_Y)
515 IERROR = SET_U_GEO(31,F_Z)
516 IERROR = SET_U_GEO(32,F_XX)
517 IERROR = SET_U_GEO(33,F_YY)
518 IERROR = SET_U_GEO(34,F_ZZ)
519 ENDIF ! IF (IDAMP > 0)
520!
521 RNC_FILTER = NC_FILTER
522 IERROR = SET_U_GEO(35,RNC_FILTER)
523 RDAMP = IDAMP
524 IERROR = SET_U_GEO(36,RDAMP)
525C--------------------------------------------
526 IF(IS_ENCRYPTED)THEN
527 WRITE(IOUT,'(5X,A,//)')'confidential data'
528 ELSE
529 WRITE(IOUT,1000)
530 . AMAS,INER,XK,ISK,ICO,K11,K44,K55,K66,K5B,K6C,
531 . IFUN_XP,IFUN_XMI,IFUN_XMR,
532 . IFUN_XXPI,IFUN_XXMI,IFUN_XXPR,IFUN_XXMR,
533 . IFUN_YY1PI,IFUN_YY1MI,IFUN_YY1PR,IFUN_YY1MR,
534 . IFUN_ZZ1PI,IFUN_ZZ1MI,IFUN_ZZ1PR,IFUN_ZZ1MR,
535 . IFUN_YY2PI,IFUN_YY2MI,IFUN_YY2PR,IFUN_YY2MR,
536 . IFUN_ZZ2PI,IFUN_ZZ2MI,IFUN_ZZ2PR,IFUN_ZZ2MR,
537 . FSCAL_X,FSCAL_RX,FSCAL_RY1,FSCAL_RY2 ,FSCAL_RZ1,FSCAL_RZ2,
538 . XLIMG,XLIM,XXLIM,YY1LIM,ZZ1LIM,YY2LIM,ZZ2LIM,
539 . NC_FILTER,IFUN_DAMP_X,IFUN_DAMP_Y,IFUN_DAMP_Z,
540 . IFUN_DAMP_XX,IFUN_DAMP_YY,IFUN_DAMP_ZZ,
541 . FSCAL_DAMP_X,FSCAL_DAMP_Y,FSCAL_DAMP_Z,
542 . FSCAL_DAMP_XX,FSCAL_DAMP_YY,FSCAL_DAMP_ZZ,
543 . F_X,F_Y,F_Z,F_XX,F_YY,F_ZZ
544 ENDIF
545C
546 PROP_TAG(IGTYP)%G_EINT = 1
547 PROP_TAG(IGTYP)%G_FOR = 3
548 PROP_TAG(IGTYP)%G_MOM = 5
549 PROP_TAG(IGTYP)%G_SKEW = 6
550 PROP_TAG(IGTYP)%G_MASS = 1
551 PROP_TAG(IGTYP)%G_V_REPCVT = 3 ! -- VELOCITIES convected frameE (V_REPCVT)
552 PROP_TAG(IGTYP)%G_VR_REPCVT = 3 ! -- VELOCITIES convected frameE (VR_REPCVT)
553 PROP_TAG(IGTYP)%G_NUVAR = NUVAR
554C
555C-----
556 1000 FORMAT(
557 & 5X,'mass per unit length. . . . . . . . . .=',E12.4/,
558 & 5X,'inertia per unit length . . . . . . . .=',E12.4/,
559 & 5X,'stiffness for interface k=e*a/l . . . .=',E12.4/,
560 & 5X,'skew frame id . . . . . . . . . . . . .=',I8/,
561 & 5X,'coupling flag . . . . . . . . . . . . .=',I8/,
562 & 5X,'stiffness k11=e*a (TENSION COMPRESSION)=',E12.4/,
563 & 5X,'stiffness k44=g*ix (TORSION). . . . . .=',E12.4/,
564 & 5X,'stiffness k55=4*e*iy (Y11 BENDING). . .=',E12.4/,
565 & 5X,'stiffness k66=4*e*iz (Z11 BENDING). . .=',E12.4/,
566 & 5X,'stiffness k5b=2*e*iy (Y12 BENDING). . .=',E12.4/,
567 & 5X,'stiffness k6c=2*e*iz (Z12 BENDING). . .=',E12.4/,
568 & 5X,'traction user function id . . . . . . .=',I8/,
569 & 5X,'initial compression user function id. .=',I8/,
570 & 5X,'final compression user function id. . .=',I8/,
571 & 5X,'initial max torsion user function id. .=',I8/,
572 & 5X,'initial min torsion user function id. .=',I8/,
573 & 5X,'final max torsion user function id. . .=',I8/,
574 & 5X,'final min torsion user function id. . .=',I8/,
575 & 5X,'initial max y bending node 1 func. id .=',I8/,
576 & 5X,'initial min y bending node 1 func. id .=',I8/,
577 & 5X,'final max y bending node 1 func. id . .=',I8/,
578 & 5X,'final min y bending node 1 func. id . .=',I8/,
579 & 5X,'initial max z bending node 1 func. id .=',I8/,
580 & 5X,'initial min z bending node 1 func. id .=',I8/,
581 & 5X,'final max z bending node 1 func. id . .=',I8/,
582 & 5X,'final min z bending node 1 func. id . .=',I8/,
583 & 5X,'initial max y bending node 2 func. id .=',I8/,
584 & 5X,'initial min y bending node 2 func. id .=',I8/,
585 & 5X,'final max y bending node 2 func. id . .=',I8/,
586 & 5X,'final min y bending node 2 func. id . .=',I8/,
587 & 5X,'initial max z bending node 2 func. id .=',I8/,
588 & 5X,'initial min z bending node 2 func. id .=',I8/,
589 & 5X,'final max z bending node 2 func. id . .=',I8/,
590 & 5X,'final min z bending node 2 func. id . .=',I8/,
591 & 5X,'scale factor for traction functions . .=',E12.4/,
592 & 5X,'scale factor for torsion x functions. .=',E12.4/,
593 & 5X,'scale factor for bending y at node 1. .=',e12.4/,
594 & 5x,'SCALE FACTOR FOR BENDING Z AT NODE 1. .=',e12.4/,
595 & 5x,'SCALE FACTOR FOR BENDING Y AT NODE 2. .=',e12.4/,
596 & 5x,'SCALE FACTOR FOR BENDING Z AT NODE 2. .=',e12.4/,
597 & 5x,'global compression transition def.. . .=',E12.4/,
598 & 5X,'local compression transition def. . . .=',E12.4/,
599 & 5X,'local torsion transition deformation. .=',E12.4/,
600 & 5X,'local y bending node 1 transition def..=',E12.4/,
601 & 5X,'local z bending node 1 transition def..=',E12.4/,
602 & 5X,'local y bending node 2 transition def..=',E12.4/,
603 & 5X,'local z bending node 2 transition def..=',E12.4/,
604!---
605! filtering
606 & 5X,'smooth strain rate filtering. .. . . . =',I10/,
607! damping
608 & 5X,'damping force-elongation rate curve for x dof . . . .=',I10/,
609 & 5X,'damping force-elongation rate curve for y dof . . . .=',I10/,
610 & 5X,'damping force-elongation rate curve for z dof . . . .=',I10/,
611 & 5X,'damping moment-rotation rate curve for xx dof . . . .=',I10/,
612 & 5X,'damping moment-rotation rate curve for yy dof . . . .=',I10/,
613 & 5X,'damping moment-rotation rate curve for zz dof . . . .=',I10/,
614 & 5X,'linear/FUNCTION damping scale factor for x dof. . . .=',1PG20.13/,
615 & 5X,'linear/function damping scale factor for y dof. . . .=',1PG20.13/,
616 & 5X,'linear/function damping scale factor for z dof. . . .=',1PG20.13/,
617 & 5X,'linear/function damping scale factor for xx dof. . . .=',1PG20.13/,
618 & 5X,'linear/function damping scale factor for yy dof. . . .=',1PG20.13/,
619 & 5X,'linear/function damping scale factor for zz dof. . . .=',1PG20.13/,
620 & 5X,'abscissa scale factor on force-elongation rate curve x dof. . =',1PG20.13/,
621 & 5X,'abscissa scale factor on force-elongation rate curve y dof. . =',1PG20.13/,
622 & 5X,'abscissa scale factor on force-elongation rate curve z dof. . =',1PG20.13/,
623 & 5X,'abscissa scale factor on moment-rotation rate curve xx dof. . =',1PG20.13/,
624 & 5X,'abscissa scale factor on moment-rotation rate curve yy dof. . =',1PG20.13/,
625 & 5X,'abscissa scale factor on moment-rotation rate curve zz dof. . =',1PG20.13//)
626!---
627C-----------
628 RETURN
629 END SUBROUTINE HM_READ_PROP44
#define my_real
Definition cppsort.cpp:32
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)
subroutine hm_read_prop44(iout, ig, nuvar, pargeo, unitab, iskn, igeo, titr, igtyp, prop_tag, lsubmodel, sub_id)
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
initmumps id
for(i8=*sizetab-1;i8 >=0;i8--)
integer, parameter nchartitle