OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop28.F File Reference
#include "implicit_f.inc"
#include "tablen_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_prop28 (iout, nuvar, pargeo, unitab, id, titr, igtyp, prop_tag, lsubmodel, iunit)

Function/Subroutine Documentation

◆ hm_read_prop28()

subroutine hm_read_prop28 ( integer iout,
integer, dimension(*) nuvar,
pargeo,
type (unit_type_), intent(in) unitab,
integer id,
character(len=nchartitle) titr,
integer igtyp,
type(prop_tag_), dimension(0:maxprop) prop_tag,
type(submodel_data), dimension(*), intent(in) lsubmodel,
integer iunit )

Definition at line 43 of file hm_read_prop28.F.

45C-----------------------------------------------
46 USE unitab_mod
47 USE message_mod
48 USE elbuftag_mod
49 USE submodel_mod
50 USE names_and_titles_mod , ONLY : nchartitle, ncharline, ncharfield
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "tablen_c.inc"
59C----------+---------+---+---+--------------------------------------------
60C VAR | SIZE |TYP| RW| DEFINITION
61C----------+---------+---+---+--------------------------------------------
62C IIN | 1 | I | R | INPUT FILE UNIT (D00 file)
63C IOUT | 1 | I | R | OUTPUT FILE UNIT (L00 file)
64C NUVAR | 2 | I | R | NUMBER OF USER ELEMENT VARIABLES
65C | NUMBER OF USER ELEMENT VARIABLES PER NODE
66C----------+---------+---+---+--------------------------------------------
67C PARGEO | * | F | W | 1)SKEW NUMBER
68C | | | | 2)STIFNESS FOR INTERFACE
69C | | | | 3)FRONT WAVE OPTION
70C | | | | 4)... not yet used
71C----------+---------+---+---+--------------------------------------------
72C
73C This subroutine reads the user geometry parameters.
74C
75C The geometry datas has to bee stored in radioss storage
76C with the function SET_U_GEO(value_index,value).
77C
78C If some standard radioss functions (time function or
79C x,y function) are used, this function IDs has to
80C bee stored with the function SET_U_PNU(func_index,func_id,KFUNC).
81C
82C If this property refers to a user material, this
83C material IDs has to bee stored with the function
84C SET_U_PNU(mat_index,mat_id,KMAT).
85C
86C If this property refers to a user property, this
87C sub-property IDs has to bee stored with the function
88C SET_U_PNU(sub_prop_index,sub_prop_id,KPROP).
89C
90C SET_U_GEO and SET_U_PNU return 0 if no error
91C SET_U_GEO and SET_U_PNU return the maximum allowed index
92C if index is larger than this maximum
93C-----------------------------------------------
94C D u m m y A r g u m e n t s
95C-----------------------------------------------
96 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
97 INTEGER IOUT,NUVAR(*),IGTYP,IUNIT
98 my_real pargeo(*)
99 INTEGER SET_U_PNU,SET_U_GEO,
100 . KFUNC
101 EXTERNAL set_u_pnu,set_u_geo
102 parameter(kfunc=29)
103 INTEGER ID
104 CHARACTER(LEN=NCHARTITLE) :: TITR
105 TYPE(PROP_TAG_) , DIMENSION(0:MAXPROP) :: PROP_TAG
106 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
107C-----------------------------------------------
108C L o c a l V a r i a b l e s
109C-----------------------------------------------
110 INTEGER IERROR,I
111 INTEGER IFUNC, IFV, IVTYP, NIP
112 my_real
113 . xk,xvtyp,rho, xc, dmn, dmx, mu1, mu2, fric,y_scal,x_scal
114 my_real
115 . fac_m, fac_l, fac_t
116 CHARACTER(LEN=NCHARFIELD) :: KEYWORD
117 CHARACTER(LEN=NCHARLINE) :: CART
118 INTEGER IP
119 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
120
121C=======================================================================
122C
123 is_encrypted = .false.
124 is_available = .false.
125C--------------------------------------------------
126C EXTRACT DATA (IS OPTION CRYPTED)
127C--------------------------------------------------
128 CALL hm_option_is_encrypted(is_encrypted)
129C--------------------------------------------------
130C EXTRACT DATAS (INTEGER VALUES)
131C--------------------------------------------------
132 CALL hm_get_intv('FUN_A1',ifunc,is_available,lsubmodel)
133 CALL hm_get_intv('FUN_B1',ifv,is_available,lsubmodel)
134 CALL hm_get_intv('NIP',nip,is_available,lsubmodel)
135C--------------------------------------------------
136C EXTRACT DATAS (REAL VALUES)
137C--------------------------------------------------
138 CALL hm_get_floatv('MASS',rho,is_available,lsubmodel,unitab)
139 CALL hm_get_floatv('STIFF2',xk,is_available,lsubmodel,unitab)
140 CALL hm_get_floatv('DAMP2',xc,is_available,lsubmodel,unitab)
141 CALL hm_get_floatv('STRAIN1',dmn,is_available,lsubmodel,unitab)
142 CALL hm_get_floatv('STRAIN2',dmx,is_available,lsubmodel,unitab)
143 CALL hm_get_floatv('FScale11',y_scal,is_available,lsubmodel,unitab)
144 CALL hm_get_floatv('FScale22',x_scal,is_available,lsubmodel,unitab)
145 CALL hm_get_floatv('MAT_MUE1',mu1,is_available,lsubmodel,unitab)
146 CALL hm_get_floatv('MAT_MUE2',mu2,is_available,lsubmodel,unitab)
147C
148C----------------------
149C
150 WRITE(iout,1400) id
151C
152 cart=' '
153 pargeo(1) = 0
154C secnd only in interfaces.
155 pargeo(2) = 0.0
156C-------------------------------------------------------
157 nuvar(1) = 3
158 nuvar(2) = 5
159C
160 fac_m = unitab%FAC_M(iunit)
161 fac_l = unitab%FAC_L(iunit)
162 fac_t = unitab%FAC_T(iunit)
163C
164 IF (dmn == zero) dmn=-ep30
165 IF (dmx == zero) dmx= ep30
166 IF (y_scal == zero) y_scal = one * fac_m * fac_l / ( fac_t * fac_t )
167 IF (x_scal == zero) x_scal = one / fac_t
168C
169 ierror = set_u_geo(10,mu1)
170 IF (ierror>0) THEN
171 CALL ancmsg(msgid=378,
172 . msgtype=msgerror,
173 . anmode=aninfo_blind_1,
174 . i1=id,
175 . c1=titr,
176 . c2='SET_U_GEO(10,MU1)')
177 ENDIF
178 ierror = set_u_geo(11,mu2)
179 IF (ierror>0) THEN
180 CALL ancmsg(msgid=378,
181 . msgtype=msgerror,
182 . anmode=aninfo_blind_1,
183 . i1=id,
184 . c1=titr,
185 . c2='SET_U_GEO(11,MU2)')
186 ENDIF
187 ierror = set_u_geo(3,rho)
188 IF (ierror>0) THEN
189 CALL ancmsg(msgid=378,
190 . msgtype=msgerror,
191 . anmode=aninfo_blind_1,
192 . i1=id,
193 . c1=titr,
194 . c2='SET_U_GEO(3,RHO)')
195 ENDIF
196 ierror = set_u_geo(4,xk)
197 IF (ierror>0) THEN
198 CALL ancmsg(msgid=378,
199 . msgtype=msgerror,
200 . anmode=aninfo_blind_1,
201 . i1=id,
202 . c1=titr,
203 . c2='SET_U_GEO(4,XK)')
204 ENDIF
205 ierror = set_u_geo(5,xc)
206 IF (ierror>0) THEN
207 CALL ancmsg(msgid=378,
208 . msgtype=msgerror,
209 . anmode=aninfo_blind_1,
210 . i1=id,
211 . c1=titr,
212 . c2='SET_U_GEO(5,XC)')
213 ENDIF
214 ierror = set_u_pnu(1,ifunc,kfunc)
215 IF (ierror>0) THEN
216 CALL ancmsg(msgid=378,
217 . msgtype=msgerror,
218 . anmode=aninfo_blind_1,
219 . i1=id,
220 . c1=titr,
221 . c2='SET_U_PNU(1,IFUNC,KFUNC)')
222 ENDIF
223 ierror = set_u_pnu(2,ifv,kfunc)
224 IF (ierror>0) THEN
225 CALL ancmsg(msgid=378,
226 . msgtype=msgerror,
227 . anmode=aninfo_blind_1,
228 . i1=id,
229 . c1=titr,
230 . c2='SET_U_PNU(2,IFV,KFUNC)')
231 ENDIF
232 ivtyp=100
233 xvtyp=ivtyp
234 ierror = set_u_geo(7,xvtyp)
235 IF (ierror>0) THEN
236 CALL ancmsg(msgid=378,
237 . msgtype=msgerror,
238 . anmode=aninfo_blind_1,
239 . i1=id,
240 . c1=titr,
241 . c2='SET_U_GEO(7,XVTYP)')
242 ENDIF
243 ierror = set_u_geo(8,dmn)
244 IF (ierror>0) THEN
245 CALL ancmsg(msgid=378,
246 . msgtype=msgerror,
247 . anmode=aninfo_blind_1,
248 . i1=id,
249 . c1=titr,
250 . c2='SET_U_GEO(8,DMN)')
251 ENDIF
252 ierror = set_u_geo(9,dmx)
253 IF (ierror>0) THEN
254 CALL ancmsg(msgid=378,
255 . msgtype=msgerror,
256 . anmode=aninfo_blind_1,
257 . i1=id,
258 . c1=titr,
259 . c2='SET_U_GEO(9,DMX)')
260 ENDIF
261 IF(rho==0.)THEN
262 CALL ancmsg(msgid=423,
263 . msgtype=msgerror,
264 . anmode=aninfo,
265 . i1=id,
266 . c1=titr)
267 ENDIF
268C
269 ierror = set_u_geo(12,y_scal)
270 IF (ierror > 0) THEN
271 CALL ancmsg(msgid=378,
272 . msgtype=msgerror,
273 . anmode=aninfo_blind_1,
274 . i1=id,
275 . c1=titr,
276 . c2='SET_U_GEO(12,Y_SCAL)')
277 ENDIF
278 ierror = set_u_geo(13,one/x_scal)
279 IF (ierror > 0) THEN
280 CALL ancmsg(msgid=378,
281 . msgtype=msgerror,
282 . anmode=aninfo_blind_1,
283 . i1=id,
284 . c1=titr,
285 . c2='SET_U_GEO(13,X_SCAL)')
286 ENDIF
287C
288 IF(.NOT. is_encrypted)THEN
289 WRITE(iout,3000) rho,xk,xc,ifunc,ifv,y_scal,x_scal,
290 . dmn,dmx,mu1,mu2
291 ELSE
292 WRITE(iout,'(5X,A)')' NSTRAND PROPERTY SET'
293 WRITE(iout,'(5X,A,/)')' --------------------'
294 WRITE(IOUT,'(5x,a,//)')' confidential data'
295 ENDIF
296C
297 DO I=1,475
298C non user specified coefficient is set to negative value.
299 FRIC=-1.0
300 IERROR=SET_U_GEO(50+I,FRIC)
301 IF (IERROR>0) THEN
302 CALL ANCMSG(MSGID=378,
303 . MSGTYPE=MSGERROR,
304 . ANMODE=ANINFO_BLIND_1,
305 . I1=ID,
306 . C1=TITR,
307 . C2='set_u_geo(50+i,fric)')
308 ENDIF
309 IERROR=SET_U_GEO(525+I,FRIC)
310 IF (IERROR>0) THEN
311 CALL ANCMSG(MSGID=378,
312 . MSGTYPE=MSGERROR,
313 . ANMODE=ANINFO_BLIND_1,
314 . I1=ID,
315 . C1=TITR,
316 . C2='set_u_geo(525+i,fric)')
317 ENDIF
318 ENDDO
319C
320 WRITE(IOUT,4000)
321C
322 DO IP=1,NIP
323C
324 CALL HM_GET_STRING_INDEX('name_array',KEYWORD,IP,6,IS_AVAILABLE)
325 CALL HM_GET_INT_ARRAY_INDEX('nb1_arr',I,IP,IS_AVAILABLE,LSUBMODEL)
326 CALL HM_GET_FLOAT_ARRAY_INDEX('mu_arr',FRIC,IP,IS_AVAILABLE,LSUBMODEL,UNITAB)
327C
328 IF (KEYWORD(1:6)=='pulley') THEN
329.OR. IF (I<2I>475) THEN
330 CALL ANCMSG(MSGID=379,
331 . MSGTYPE=MSGERROR,
332 . ANMODE=ANINFO_BLIND_1,
333 . I1=ID,
334 . C1=TITR,
335 . C2='pulley',
336 . I2=I)
337 ENDIF
338 IERROR=SET_U_GEO(50+I,FRIC)
339 IF (IERROR>0) THEN
340 CALL ANCMSG(MSGID=378,
341 . MSGTYPE=MSGERROR,
342 . ANMODE=ANINFO_BLIND_1,
343 . I1=ID,
344 . C1=TITR,
345 . C2='set_u_geo(50+i,fric)')
346 ENDIF
347.NOT. IF( IS_ENCRYPTED) WRITE(IOUT,'(a,i10,a,1pg20.13)')
348 . 'pulley friction coefficient : pulley number =',I,
349 . 'VALUE =',FRIC
350 ELSEIF (KEYWORD(1:6)=='strand') THEN
351.OR. IF (I<1I>475) THEN
352 CALL ANCMSG(MSGID=379,
353 . MSGTYPE=MSGERROR,
354 . ANMODE=ANINFO_BLIND_1,
355 . I1=ID,
356 . C1=TITR,
357 . C2='strand',
358 . I2=I)
359 ENDIF
360 IERROR=SET_U_GEO(525+I,FRIC)
361 IF (IERROR>0) THEN
362 CALL ANCMSG(MSGID=378,
363 . MSGTYPE=MSGERROR,
364 . ANMODE=ANINFO_BLIND_1,
365 . I1=ID,
366 . C1=TITR,
367 . C2='set_u_geo(525+i,fric)')
368 ENDIF
369c
370.NOT. IF( IS_ENCRYPTED) WRITE(IOUT,'(a,i10,a,1pg20.13)')
371 . 'strand friction coefficient : strand number =',I,
372 . 'VALUE =',FRIC
373 ELSE
374 CALL ANCMSG(MSGID=380,
375 . MSGTYPE=MSGERROR,
376 . ANMODE=ANINFO_BLIND_1,
377 . I1=ID,
378 . C1=TITR,
379 . C2=KEYWORD)
380 ENDIF
381C
382 ENDDO
383C
384C-----------------------------
385C PROPERTY BUFFER
386C-----------------------------
387 PROP_TAG(IGTYP)%G_EINT = 1
388 PROP_TAG(IGTYP)%G_MASS = 1
389 PROP_TAG(IGTYP)%G_NUVAR = NUVAR(1)
390C PROP_TAG(IGTYP)%G_NUVARN = NINT(GEO(35,I)) ! init. in elbuf_ini
391
392C---------------------------------------------------------------
393 RETURN
394 999 CALL ANCMSG(MSGID=606,
395 . MSGTYPE=MSGERROR,
396 . ANMODE=ANINFO,
397 . C1=CART)
398 3000 FORMAT(
399 & 5X,' nstrand property set ',/,
400 & 5X,' -------------------- ',/,
401 & 5X,'mass per length unit. . . . . . . . . .=',1PG20.13/,
402 & 5X,'unitary stiffness . . . . . . . . . . .=',1PG20.13/,
403 & 5X,'unitary damping . . . . . . . . . . . .=',1PG20.13/,
404 & 5X,'force/strain curve number . . . . . . .=',I10/,
405 & 5X,'dynamic amplification curve number. . .=',I10/,
406 & 5X,'force scale factor. . . . . . . . . . .=',1PG20.13/,
407 & 5X,'strain rate scale factor. . . . . . . .=',1PG20.13/,
408 & 5X,'negative failure strain . . . . . . . .=',1PG20.13/,
409 & 5X,'positive failure strain . . . . . . . .=',1PG20.13/,
410 & 5X,'pulley friction default coefficient . .=',1PG20.13/,
411 & 5X,'strand friction default coefficient . .=',1PG20.13/)
412 4000 FORMAT(
413 & 5X,' specified friction coefficients : ',/,
414 & 5X,' +++++++++++++++++++++++++++++++ ',/)
415C
416 1400 FORMAT(
417 & 5X,'user property set'/,
418 & 5X,'property set number . . . . . . . . . .=',I10)
419c
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:415
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284
id
initmumps id
Definition multiplerhs_example.m:4
elbuftag_mod
Definition elbuftag_mod.F:227
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1001
submodel_mod
Definition submodel_mod.F:712
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
set_u_pnu
integer function set_u_pnu(ivar, ip, k)
Definition uaccess.F:127
set_u_geo
integer function set_u_geo(ivar, a)
Definition uaccess.F:64