OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop33_plan_jnt.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_prop33_plan_jnt ../starter/source/properties/spring/hm_read_prop33_plan_jnt.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_prop33 ../starter/source/properties/spring/hm_read_prop33.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_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
31!|| set_u_geo ../starter/source/user_interface/uaccess.F
32!|| set_u_pnu ../starter/source/user_interface/uaccess.F
33!||--- uses -----------------------------------------------------
34!|| message_mod ../starter/share/message_module/message_mod.F
35!|| submodel_mod ../starter/share/modules1/submodel_mod.F
36!||====================================================================
37 SUBROUTINE hm_read_prop33_plan_jnt(IOUT, ITYP, SKFLAG, PARGEO,IS_ENCRYPTED,
38 . UNITAB,IUNIT,ID,TITR,LSUBMODEL)
39 USE unitab_mod
40 USE message_mod
41 USE submodel_mod
42 USE names_and_titles_mod , ONLY : nchartitle
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C A n a l y s e M o d u l e
49C-----------------------------------------------
50C----------+---------+---+---+--------------------------------------------
51C VAR | SIZE |TYP| RW| DEFINITION
52C----------+---------+---+---+--------------------------------------------
53C IOUT | 1 | I | R | OUTPUT FILE UNIT (L00 file)
54C----------+---------+---+---+--------------------------------------------
55C PARGEO | * | F | W | 1)SKEW NUMBER
56C | | | | 2)STIFNESS FOR INTERFACE
57C | | | | 3)FRONT WAVE OPTION
58C | | | | 4)... not yet used
59C----------+---------+---+---+------------------------------------------|
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
63 INTEGER IOUT, ITYP, SKFLAG,IUNIT
64 my_real pargeo(*)
65
66 INTEGER ID
67 CHARACTER(LEN=NCHARTITLE) :: TITR
68 LOGICAL IS_ENCRYPTED
69 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
70C=======================================================================
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER IERROR,IDSK1,IDSK2,IFUN_YY,IFUN_ZZ,IFUN_RX,
74 . ifun_cyy,ifun_czz,ifun_crx, zeroi,oflag
75 my_real
76 . xk,xtyp,xflg,xsk1,xsk2,knn,kyy,kzz,krx,cr,cyy,czz,crx,mass,iner,
77 . fac_m,fac_l,fac_t,fac_ct,fac_cr,fac_kt,fac_kr,fac_ctx,fac_crx,
78 . fac_ff,fac_mm
79C-----------------------------------------------
80 INTEGER SET_U_PNU,SET_U_GEO,KFUNC
81 EXTERNAL set_u_pnu,set_u_geo
82 parameter(kfunc=29)
83 DATA zeroi/0/
84 LOGICAL IS_AVAILABLE
85C=======================================================================
86C---- PLANAR JOINT
87C=======================================================================
88 fac_m = unitab%FAC_M(iunit)
89 fac_l = unitab%FAC_L(iunit)
90 fac_t = unitab%FAC_T(iunit)
91 fac_ff = fac_m / fac_t
92 fac_mm = one / fac_t
93 fac_ct = fac_m / fac_t
94 fac_cr = fac_m * fac_l**2 / fac_t
95 fac_kt = fac_ct / fac_t
96 fac_kr = fac_cr / fac_t
97 fac_ctx = fac_t / fac_l
98 fac_crx = fac_t
99 oflag = 0
100C
101C--------------------------------------------------
102C EXTRACT DATAS (INTEGER VALUES)
103C--------------------------------------------------
104 CALL hm_get_intv('Idsk1',idsk1,is_available,lsubmodel)
105 CALL hm_get_intv('Idsk2',idsk2,is_available,lsubmodel)
106 CALL hm_get_intv('Yt_fun',ifun_yy,is_available,lsubmodel)
107 CALL hm_get_intv('Zt_fun',ifun_zz,is_available,lsubmodel)
108 CALL hm_get_intv('Xr_fun',ifun_rx,is_available,lsubmodel)
109C--------------------------------------------------
110C EXTRACT DATAS (REAL VALUES)
111C--------------------------------------------------
112 CALL hm_get_floatv('Xk',xk,is_available,lsubmodel,unitab)
113 CALL hm_get_floatv('Cr',cr,is_available,lsubmodel,unitab)
114 CALL hm_get_floatv('kn',KNN,IS_AVAILABLE,LSUBMODEL,UNITAB)
115 CALL HM_GET_FLOATV('kty',KYY,IS_AVAILABLE,LSUBMODEL,UNITAB)
116 CALL HM_GET_FLOATV('ktz',KZZ,IS_AVAILABLE,LSUBMODEL,UNITAB)
117 CALL HM_GET_FLOATV('krx',KRX,IS_AVAILABLE,LSUBMODEL,UNITAB)
118C--- viscosity
119C--------------------------------------------------
120C EXTRACT DATAS (INTEGER VALUES)
121C--------------------------------------------------
122 CALL HM_GET_INTV('cty_fun',IFUN_CYY,IS_AVAILABLE,LSUBMODEL)
123.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
124 CALL HM_GET_INTV('ctz_fun',IFUN_CZZ,IS_AVAILABLE,LSUBMODEL)
125.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
126 CALL HM_GET_INTV('crx_fun',IFUN_CRX,IS_AVAILABLE,LSUBMODEL)
127.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
128C--------------------------------------------------
129C EXTRACT DATAS (REAL VALUES)
130C--------------------------------------------------
131 CALL HM_GET_FLOATV('cty',CYY,IS_AVAILABLE,LSUBMODEL,UNITAB)
132.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
133 CALL HM_GET_FLOATV('ctz',CZZ,IS_AVAILABLE,LSUBMODEL,UNITAB)
134.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
135 CALL HM_GET_FLOATV('crx',CRX,IS_AVAILABLE,LSUBMODEL,UNITAB)
136.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
137C-----------------------
138.OR. IF (IDSK1<=0IDSK1<=0) THEN
139 CALL ANCMSG(MSGID=386,
140 . MSGTYPE=MSGERROR,
141 . ANMODE=ANINFO_BLIND_1,
142 . I1=ID,
143 . C1=TITR)
144 ENDIF
145 IF (KNN==0.) THEN
146 CALL ANCMSG(MSGID=387,
147 . MSGTYPE=MSGERROR,
148 . ANMODE=ANINFO_BLIND_1,
149 . I1=ID,
150 . C1=TITR)
151 ENDIF
152.OR. IF (CR<ZEROCR>1.) THEN
153 CALL ANCMSG(MSGID=388,
154 . MSGTYPE=MSGERROR,
155 . ANMODE=ANINFO_BLIND_1,
156 . I1=ID,
157 . C1=TITR)
158 ENDIF
159 IF (CR==ZERO) CR = FIVEEM2
160C
161 XTYP = ITYP
162 XFLG = SKFLAG
163 XSK1 = IDSK1
164 XSK2 = IDSK2
165 MASS = ZERO
166 INER = ZERO
167C
168.AND. IF(KYY==ZEROIFUN_YY/=0) KYY = ONE
169.AND. IF(KZZ==ZEROIFUN_ZZ/=0) KZZ = ONE
170.AND. IF(KRX==ZEROIFUN_RX/=0) KRX = ONE
171.AND. IF(CYY==ZEROIFUN_CYY/=0)CYY = ONE
172.AND. IF(CZZ==ZEROIFUN_CZZ/=0)CZZ = ONE
173.AND. IF(CRX==ZEROIFUN_CRX/=0)CRX = ONE
174C-----------------------
175 IF (IFUN_YY /= 0) KYY = KYY * FAC_FF
176 IF (IFUN_ZZ /= 0) KZZ = KZZ * FAC_FF
177 IF (IFUN_RX /= 0) KRX = KRX * FAC_MM
178 IF (IFUN_CYY /= 0) CYY = CYY * FAC_FF
179 IF (IFUN_CZZ /= 0) CZZ = CZZ * FAC_FF
180 IF (IFUN_CRX /= 0) CRX = CRX * FAC_MM
181C-----------------------
182 PARGEO(1) = 0
183 PARGEO(2) = XK
184 PARGEO(3) = 0
185C-----------------------
186 IERROR = SET_U_GEO(1,XTYP)
187 IERROR = SET_U_GEO(2,XSK1)
188 IERROR = SET_U_GEO(3,XSK2)
189 IERROR = SET_U_GEO(4,KNN)
190 IERROR = SET_U_GEO(5,KYY)
191 IERROR = SET_U_GEO(6,KZZ)
192 IERROR = SET_U_GEO(7,KRX)
193 IERROR = SET_U_GEO(8,KNN)
194 IERROR = SET_U_GEO(9,KNN)
195 IERROR = SET_U_GEO(10,KNN)
196 IERROR = SET_U_GEO(11,ZERO)
197 IERROR = SET_U_GEO(12,MASS)
198 IERROR = SET_U_GEO(13,INER)
199 IERROR = SET_U_GEO(14,XFLG)
200 IERROR = SET_U_GEO(15,CR)
201 IERROR = SET_U_GEO(16,ZERO)
202 IERROR = SET_U_GEO(17,ZERO)
203 IERROR = SET_U_GEO(18,ZERO)
204 IERROR = SET_U_GEO(19,CR)
205 IERROR = SET_U_GEO(20,CR)
206 IERROR = SET_U_GEO(21,ZERO)
207 IERROR = SET_U_GEO(22,CYY)
208 IERROR = SET_U_GEO(23,CZZ)
209 IERROR = SET_U_GEO(24,CRX)
210 IERROR = SET_U_GEO(25,ZERO)
211 IERROR = SET_U_GEO(26,ZERO)
212 IERROR = SET_U_GEO(27,FAC_CTX)
213 IERROR = SET_U_GEO(28,FAC_CRX)
214 IERROR = SET_U_PNU(1,ZEROI,KFUNC)
215 IERROR = SET_U_PNU(2,IFUN_YY,KFUNC)
216 IERROR = SET_U_PNU(3,IFUN_ZZ,KFUNC)
217 IERROR = SET_U_PNU(4,IFUN_RX,KFUNC)
218 IERROR = SET_U_PNU(5,ZEROI,KFUNC)
219 IERROR = SET_U_PNU(6,ZEROI,KFUNC)
220 IERROR = SET_U_PNU(7,ZEROI,KFUNC)
221 IERROR = SET_U_PNU(8,IFUN_CYY,KFUNC)
222 IERROR = SET_U_PNU(9,IFUN_CZZ,KFUNC)
223 IERROR = SET_U_PNU(10,IFUN_CRX,KFUNC)
224 IERROR = SET_U_PNU(11,ZEROI,KFUNC)
225 IERROR = SET_U_PNU(12,ZEROI,KFUNC)
226C-----------------------
227 WRITE(IOUT,500)
228 IF(IS_ENCRYPTED)THEN
229 WRITE(IOUT,'(5x,a,//)')'confidential data'
230 ELSE
231 IF (OFLAG==6) THEN
232 WRITE(IOUT,1001) IDSK1,IDSK2,XK,CR,KNN,KYY,KZZ,KRX,
233 . IFUN_YY,IFUN_ZZ,IFUN_RX
234 ELSE
235 WRITE(IOUT,1000) IDSK1,IDSK2,XK,CR,KNN,KYY,KZZ,KRX,
236 . IFUN_YY,IFUN_ZZ,IFUN_RX,
237 . CYY,CZZ,CRX,IFUN_CYY,IFUN_CZZ,IFUN_CRX
238 ENDIF
239 ENDIF
240C-----------------------
241 RETURN
242 500 FORMAT(
243 & 5X,'joint TYPE . . . . . . . . . . planar joint'//)
244 1000 FORMAT(
245 & 5X,'skew 1 frame id. . . . . . . . . . . . =',I10/,
246 & 5X,'skew 2 frame id. . . . . . . . . . . . =',I10/,
247 & 5X,'stiffness for INTERFACE k=e*a/l. . . . =',1PG20.13/,
248 & 5X,'critical damping coefficient . . . . . =',1pg20.13/,
249 & 5x,'BLOCKING STIFFNESS KNN . . . . . . . . =',1pg20.13/,
250 & 5x,'LINEAR TRANSLATIONAL STIFFNESS KYY . . =',1pg20.13/,
251 & 5x,'LINEAR TRANSLATIONAL STIFFNESS KZZ . . =',1pg20.13/,
252 & 5x,'LINEAR TORSION STIFFNESS KRX . . . . . =',1pg20.13/,
253 & 5x,'USER Y TRANSLATION FUNCTION. . . . . . =',i10/,
254 & 5x,'USER Z TRANSLATION FUNCTION. . . . . . =',i10/,
255 & 5x,'USER RX TORSION FUNCTION ID. . . . . . =',i10/,
256 & 5x,'LINEAR DAMPING CYY . . . . . . . . . . =',1pg20.13/,
257 & 5x,'LINEAR DAMPING CZZ . . . . . . . . . . =',1pg20.13/,
258 & 5x,'LINEAR DAMPING CRX . . . . . . . . . . =',1pg20.13/,
259 & 5x,'USER YY DAMPING FUNCTION . . . . . . . =',i10/,
260 & 5x,'USER ZZ DAMPING FUNCTION . . . . . . . =',i10/,
261 & 5x,'USER RX DAMPING FUNCTION . . . . . . . =',i10//)
262 1001 FORMAT(
263 & 5x,'SKEW 1 FRAME ID. . . . . . . . . . . . =',i10/,
264 & 5x,'SKEW 2 FRAME ID. . . . . . . . . . . . =',i10/,
265 & 5x,'STIFFNESS FOR INTERFACE K=E*A/L. . . . =',1pg20.13/,
266 & 5x,'CRITICAL DAMPING COEFFICIENT . . . . . =',1pg20.13/,
267 & 5x,'BLOCKING STIFFNESS KNN . . . . . . . . =',1pg20.13/,
268 & 5x,'LINEAR TRANSLATIONAL STIFFNESS KYY . . =',1pg20.13/,
269 & 5x,'LINEAR TRANSLATIONAL STIFFNESS KZZ . . =',1pg20.13/,
270 & 5x,'LINEAR TORSION STIFFNESS KRX . . . . . =',1pg20.13/,
271 & 5x,'USER Y TRANSLATION FUNCTION. . . . . . =',i10/,
272 & 5x,'user z translation function. . . . . . =',I10/,
273 & 5X,'user rx torsion FUNCTION id. . . . . . =',I10//)
274 RETURN
275 END
my_real
#define my_real
Definition cppsort.cpp:32
damping
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:418
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_read_prop33_plan_jnt
subroutine hm_read_prop33_plan_jnt(iout, ityp, skflag, pargeo, is_encrypted, unitab, iunit, id, titr, lsubmodel)
Definition hm_read_prop33_plan_jnt.F:39
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
submodel_mod::submodel_data
Definition submodel_mod.F:728