OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_damp.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "sphcom.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_damp (dampr, igrnod, iskn, lsubmodel, unitab, snpc1, npc1, ndamp_vrel_rby, igrpart, damp_range_part)

Function/Subroutine Documentation

◆ hm_read_damp()

subroutine hm_read_damp ( dampr,
type (group_), dimension(ngrnod), target igrnod,
integer, dimension(liskn,*) iskn,
type(submodel_data), dimension(*), intent(in) lsubmodel,
type (unit_type_), intent(in) unitab,
integer, intent(in) snpc1,
integer, dimension(snpc1), intent(in) npc1,
integer, intent(inout) ndamp_vrel_rby,
type (group_), dimension(ngrpart) igrpart,
integer, dimension(npart), intent(inout) damp_range_part )
Parameters
[in,out]damp_range_partflag to compute the damping range

Definition at line 42 of file hm_read_damp.F.

44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE message_mod
48 USE groupdef_mod
49 USE submodel_mod
50 USE hm_option_read_mod
51 USE unitab_mod
52 USE names_and_titles_mod , ONLY : nchartitle
53 USE damping_range_compute_param_mod
54C-----------------------------------------------
55C I m p l i c i t T y p e s
56C-----------------------------------------------
57#include "implicit_f.inc"
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "com01_c.inc"
62#include "com04_c.inc"
63#include "param_c.inc"
64#include "units_c.inc"
65#include "sphcom.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
70 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
71 INTEGER ISKN(LISKN,*)
72 INTEGER, INTENT(IN) :: SNPC1,NPC1(SNPC1)
73 INTEGER, INTENT(INOUT) :: NDAMP_VREL_RBY
74 my_real dampr(nrdamp,*)
75 INTEGER, INTENT(INOUT) :: DAMP_RANGE_PART(NPART) !< flag to compute the damping range
76C-----------------------------------------------
77 TYPE (GROUP_) ,TARGET, DIMENSION(NGRNOD) :: IGRNOD
78 TYPE (GROUP_) ,DIMENSION(NGRPART) :: IGRPART
79C-----------------------------------------------
80C E x t e r n a l F u n c t i o n s
81C-----------------------------------------------
82 INTEGER NGR2USR
83 EXTERNAL ngr2usr
84C-----------------------------------------------
85C L o c a l V a r i a b l e s
86C-----------------------------------------------
87 INTEGER I,J,ID,JGRN,ISK,FL_VREL,FL_FREQ_RANGE,ITYPE
88 INTEGER NB_PAS,RANGE,FLINT,FLG_PRI,SUB_INDEX
89 INTEGER FUNC_ID, RBODY_ID, IFUN, IGR, GRPART
90 my_real
91 . factb,tstart,tstop,
92 . alpha,beta,alpha_y,beta_y,alpha_z,beta_z,alpha_xx,beta_xx,alpha_yy,
93 . beta_yy,alpha_zz,beta_zz,cdamp_mx,cdamp_my,cdamp_mz,
94 . dv2_mx,dv2_my,dv2_mz,freq,xscale,alpha_x,
95 . cdamp,freq_low,freq_high,maxwell_alpha(3),maxwell_tau(3)
96 CHARACTER(LEN=NCHARTITLE) :: TITR,KEY
97!
98 INTEGER, DIMENSION(:), POINTER :: INGR2USR
99 LOGICAL IS_AVAILABLE
100 LOGICAL FULL_FORMAT
101!-----------------------------------------------
102! DAMPR(1,I) : user_id
103! DAMPR(2,I) : IGRNOD ID
104! DAMPR(3,I) : alpha_x
105! DAMPR(4,I) : beta_x
106! DAMPR(5,I) : alpha_y
107! DAMPR(6,I) : beta_y
108! DAMPR(7,I) : alpha_z
109! DAMPR(8,I) : beta_z
110! DAMPR(9,I) : alpha_xx
111! DAMPR(10,I) : beta_xx
112! DAMPR(11,I) : alpha_yy
113! DAMPR(12,I) : beta_yy
114! DAMPR(13,I) : alpha_zz
115! DAMPR(14,I) : beta_zz
116! DAMPR(15,I) : ISK
117! DAMPR(16,I) : alpha of FUNC, FACTB now is fixed to 1
118! DAMPR(17,I) : TSTART ! to be initialized
119! DAMPR(18,I) : TSTOP ! to be initialized
120! DAMPR(19,I) : NB_PAS (0 if not INTER, 0 : using velocity in global system) ?
121! DAMPR(20,I) : RANGE (0 if not INTER)
122! DAMPR(21,I) : (0 INTER; 1 VREL; 0 FREQ) 2 for FUNC ?
123! Itype now -> 0:/DAMP; 1:/DAMP/INTER 2:/DAMP/VREL 3:/DAMP/FREQ 4:/DAMP/FUNCT
124! DAMPR(22,I) = Alpha2_x (only for VREL )
125! DAMPR(23,I) = Alpha2_y (only for VREL )
126! DAMPR(24,I) = Alpha2_z (only for VREL )
127! DAMPR(25,I) = RBODY_ID (only for VREL )
128! DAMPR(26,I) = IFUN (for VREL&FUNCT )
129! DAMPR(27,I) = XSCALE (only for VREL )
130! DAMPR(28,I) = FREQ (only for FREQ )
131! DAMPR(29,I) = ZERO (only for FREQ )
132! DAMPR(30,I) = ZERO (only for FREQ )
133! DAMPR(31,I) = (0 INTER; 0 VREL; 1 FREQ)
134! DAMPR(32:34,I) = MAXWELL_ALPHA(1:3) (only for FREQ ) alpha_x,alpha_y,alpha_z of FUNCT
135! DAMPR(35:37,I) = MAXWELL_TAU(1:3) (only for FREQ ) alpha_xx,alpha_yy,alpha_zz of FUNCT
136!======================================================================|
137 is_available = .false.
138 WRITE(iout,1000)
139C--------------------------------------------------
140C START BROWSING MODEL /DAMP
141C--------------------------------------------------
142 CALL hm_option_start('/DAMP')
143C--------------------------------------------------
144C BROWSING MODEL DAMP 1->NDAMP
145C--------------------------------------------------
146 DO i=1,ndamp
147C--------------------------------------------------
148C EXTRACT DATAS OF /DAMP/... LINE
149C--------------------------------------------------
150 CALL hm_option_read_key(lsubmodel,
151 . option_id = id,
152 . option_titr = titr,
153 . submodel_index = sub_index,
154 . keyword2=key)
155 full_format = .false.
156C--------------------------------------------------
157C HIDDEN FLAG FACTB
158C--------------------------------------------------
159C IF(NBLINES == 2) THEN
160C IREC=IREC+1
161C READ(IIN,REC=IREC,FMT=FMT_F) FACTB
162C ENDIF
163C--> SET TO 1.0
164C--------------------------------------------------
165 flint = 0
166 fl_vrel = 0
167 fl_freq_range = 0
168 itype = 0
169 factb = one
170 alpha = zero
171 beta = zero
172C
173 IF(key(1:5)=='INTER')THEN
174 flint = 1
175 itype = 1
176 CALL hm_get_intv('Nb_time_step',nb_pas,is_available,lsubmodel)
177 CALL hm_get_intv('Range',range,is_available,lsubmodel)
178 CALL hm_get_intv('grnod_id',jgrn,is_available,lsubmodel)
179 CALL hm_get_intv('skew_id',isk,is_available,lsubmodel)
180 IF(isk == 0 .AND. sub_index /= 0 ) isk = lsubmodel(sub_index)%SKEW
181 CALL hm_get_boolv('Mass_Damp_Factor_Option',full_format,is_available)
182C--------------------------------------------------
183C EXTRACT DATAS (REAL VALUES)
184C--------------------------------------------------
185 CALL hm_get_floatv('Alpha',alpha,is_available,lsubmodel,unitab)
186 CALL hm_get_floatv('Beta',beta,is_available,lsubmodel,unitab)
187 CALL hm_get_floatv('Tstart',tstart,is_available,lsubmodel,unitab)
188 CALL hm_get_floatv('Tstop',tstop,is_available,lsubmodel,unitab)
189 CALL hm_get_floatv('Alpha_yy',alpha_yy,is_available,lsubmodel,unitab)
190 CALL hm_get_floatv('Beta_yy',beta_yy,is_available,lsubmodel,unitab)
191 CALL hm_get_floatv('Alpha_zz',alpha_zz,is_available,lsubmodel,unitab)
192 CALL hm_get_floatv('Beta_zz',beta_zz,is_available,lsubmodel,unitab)
193C--------------------------------------------------
194 IF (nb_pas == 0) nb_pas = 20
195 WRITE(iout,1300)
196 WRITE(iout,1400) nb_pas
197 WRITE(iout,1600) range
198 idamp_rdof = idamp_rdof+1
199 kcontact = 1
200 dampr(19,i) = nb_pas
201 dampr(20,i) = range
202 dampr(21,i) = 0
203 ELSEIF(key(1:4).EQ.'VREL')THEN
204 fl_vrel = 1
205 itype = 2
206C--------------------------------------------------
207C EXTRACT DATAS (INTEGER VALUES)
208C--------------------------------------------------
209 CALL hm_get_intv('grnod_id',jgrn,is_available,lsubmodel)
210 CALL hm_get_intv('skew_id',isk,is_available,lsubmodel)
211 IF(isk == 0 .AND. sub_index .NE. 0 ) isk = lsubmodel(sub_index)%SKEW
212 CALL hm_get_intv('RbodyID',rbody_id,is_available,lsubmodel)
213 CALL hm_get_intv('FuncID',func_id,is_available,lsubmodel)
214C--------------------------------------------------
215C EXTRACT DATAS (REAL VALUES)
216C--------------------------------------------------
217 CALL hm_get_floatv('Tstart',tstart,is_available,lsubmodel,unitab)
218 CALL hm_get_floatv('Tstop',tstop,is_available,lsubmodel,unitab)
219 CALL hm_get_floatv('Freq',freq,is_available,lsubmodel,unitab)
220 CALL hm_get_floatv('Xscale',xscale,is_available,lsubmodel,unitab)
221 CALL hm_get_floatv('Alpha_x',cdamp_mx,is_available,lsubmodel,unitab)
222 CALL hm_get_floatv('Alpha_y',cdamp_my,is_available,lsubmodel,unitab)
223 CALL hm_get_floatv('Alpha_z',cdamp_mz,is_available,lsubmodel,unitab)
224 CALL hm_get_floatv('Alpha2_x',dv2_mx,is_available,lsubmodel,unitab)
225 CALL hm_get_floatv('Alpha2_y',dv2_my,is_available,lsubmodel,unitab)
226 CALL hm_get_floatv('Alpha2_z',dv2_mz,is_available,lsubmodel,unitab)
227C--------------------------------------------------
228 IF (cdamp_my == zero) cdamp_my = cdamp_mx
229 IF (cdamp_mz == zero) cdamp_mz = cdamp_mx
230 IF (dv2_my == zero) dv2_my = dv2_mx
231 IF (dv2_mz == zero) dv2_mz = dv2_mx
232 IF (xscale == zero) xscale = one
233 alpha = zero
234 beta = zero
235C---------RBODY ----------------------------
236 IF (rbody_id /= 0) THEN
237 ndamp_vrel_rby = ndamp_vrel_rby + 1
238C RBODY merge - user ID of RBY is stored in DAMPR-> change to user id done after
239 ENDIF
240C---------FUNC ID user-----------------------------
241 ifun=0
242 IF (func_id /= 0) THEN
243 DO j=1,nfunct
244 IF (func_id == npc1(j)) THEN
245 ifun=j
246 EXIT
247 ENDIF
248 ENDDO
249 IF (ifun == 0)THEN ! Function not found
250 CALL ancmsg(msgid=3049,
251 . msgtype=msgerror,
252 . anmode=aninfo,
253 . i1=id,
254 . c1=titr,
255 . i2=func_id)
256 ENDIF
257 ENDIF
258C--------------------------------------------------
259 WRITE(iout,1700)
260 dampr(19,i) = 0
261 dampr(20,i) = 0
262 dampr(21,i) = 1
263 dampr(22,i) = dv2_mx
264 dampr(23,i) = dv2_my
265 dampr(24,i) = dv2_mz
266 dampr(25,i) = rbody_id
267 dampr(26,i) = ifun
268 dampr(27,i) = xscale
269 full_format = .true.
270C--------------------------------------------------
271 ELSEIF(key(1:4).EQ.'FREQ')THEN
272C--------------------------------------------------
273C Dapming in frequency range
274C--------------------------------------------------
275 itype = 3
276 fl_freq_range = 1
277C--------------------------------------------------
278C EXTRACT DATAS (INTEGER VALUES)
279C--------------------------------------------------
280 CALL hm_get_intv('grpart_id',grpart,is_available,lsubmodel)
281C---------Check part Id-----------------------------
282 IF(grpart/=0)THEN
283 igr = 0
284 DO j=1,ngrpart
285 IF (igrpart(j)%ID == grpart) THEN
286 igr=j
287 EXIT
288 END IF
289 END DO
290 IF(igr == 0) THEN
291 CALL ancmsg(msgid=3086,
292 . msgtype=msgerror,
293 . anmode=aninfo_blind_1,
294 . i1=id,
295 . c1=titr,
296 . i2=grpart)
297 ENDIF
298C---------Tag of the parts-----------------------------
299 DO j=1,igrpart(igr)%NENTITY
300 damp_range_part(igrpart(igr)%ENTITY(j)) = i
301 ENDDO
302 ELSE
303C---------Tag of all parts-----------------------------
304 DO j=1,npart
305 damp_range_part(j) = i
306 ENDDO
307 ENDIF
308 WRITE(iout,1900)
309 isk = 0
310 full_format = .true.
311 alpha = zero
312 beta = zero
313C--------------------------------------------------
314C EXTRACT DATAS (REAL VALUES)
315C--------------------------------------------------
316 CALL hm_get_floatv('Cdamp',cdamp,is_available,lsubmodel,unitab)
317 CALL hm_get_floatv('Tstart',tstart,is_available,lsubmodel,unitab)
318 CALL hm_get_floatv('Tstop',tstop,is_available,lsubmodel,unitab)
319 CALL hm_get_floatv('Freq_low',freq_low,is_available,lsubmodel,unitab)
320 CALL hm_get_floatv('Freq_high',freq_high,is_available,lsubmodel,unitab)
321C--------------------------------------------------
322 ELSEIF(key(1:5).EQ.'FUNCT')THEN
323C--------------------------------------------------
324 itype = 4
325C--------------------------------------------------
326C EXTRACT DATAS (INTEGER VALUES)
327C--------------------------------------------------
328 CALL hm_get_intv('grnod_id',jgrn,is_available,lsubmodel)
329 CALL hm_get_intv('FuncID',func_id,is_available,lsubmodel)
330C--------------------------------------------------
331C EXTRACT DATAS (REAL VALUES)
332C--------------------------------------------------
333 CALL hm_get_floatv('Alpha',alpha,is_available,lsubmodel,unitab)
334 CALL hm_get_floatv('Alpha_x',alpha_x,is_available,lsubmodel,unitab)
335 CALL hm_get_floatv('Alpha_y',alpha_y,is_available,lsubmodel,unitab)
336 CALL hm_get_floatv('Alpha_z',alpha_z,is_available,lsubmodel,unitab)
337 CALL hm_get_floatv('Alpha_xx',alpha_xx,is_available,lsubmodel,unitab)
338 CALL hm_get_floatv('Alpha_yy',alpha_yy,is_available,lsubmodel,unitab)
339 CALL hm_get_floatv('Alpha_zz',alpha_zz,is_available,lsubmodel,unitab)
340 isk = 0
341 tstart = zero
342 tstop=ep30
343 full_format = .true.
344 IF (alpha==zero) alpha = one ! default =1 to add in manual
345 factb = alpha
346 alpha = alpha_x
347!---------FUNC ID user-----------------------------
348 ifun=0
349 IF (func_id /= 0) THEN
350 DO j=1,nfunct
351 IF (func_id == npc1(j)) THEN
352 ifun=j
353 EXIT
354 ENDIF
355 ENDDO
356 IF (ifun == 0)THEN ! Function not found
357 CALL ancmsg(msgid=3049,
358 . msgtype=msgerror,
359 . anmode=aninfo,
360 . i1=id,
361 . c1=titr,
362 . i2=func_id)
363 ENDIF
364 ENDIF
365 dampr(4:nrdamp,i) = zero
366 WRITE(iout,2100)
367 ELSE
368C--------------------------------------------------
369C EXTRACT DATAS (INTEGER VALUES)
370C--------------------------------------------------
371 CALL hm_get_intv('grnod_id',jgrn,is_available,lsubmodel)
372 CALL hm_get_intv('skew_id',isk,is_available,lsubmodel)
373 IF(isk == 0 .AND. sub_index /= 0 ) isk = lsubmodel(sub_index)%SKEW
374 CALL hm_get_boolv('Mass_Damp_Factor_Option',full_format,is_available)
375C--------------------------------------------------
376C EXTRACT DATAS (REAL VALUES)
377C--------------------------------------------------
378 CALL hm_get_floatv('Alpha',alpha,is_available,lsubmodel,unitab)
379 CALL hm_get_floatv('Beta',beta,is_available,lsubmodel,unitab)
380 CALL hm_get_floatv('Tstart',tstart,is_available,lsubmodel,unitab)
381 CALL hm_get_floatv('Tstop',tstop,is_available,lsubmodel,unitab)
382 CALL hm_get_floatv('Alpha_y',alpha_y,is_available,lsubmodel,unitab)
383 CALL hm_get_floatv('Beta_y',beta_y,is_available,lsubmodel,unitab)
384 CALL hm_get_floatv('Alpha_z',alpha_z,is_available,lsubmodel,unitab)
385 CALL hm_get_floatv('Beta_z',beta_z,is_available,lsubmodel,unitab)
386 CALL hm_get_floatv('Alpha_xx',alpha_xx,is_available,lsubmodel,unitab)
387 CALL hm_get_floatv('Beta_xx',beta_xx,is_available,lsubmodel,unitab)
388 CALL hm_get_floatv('Alpha_yy',alpha_yy,is_available,lsubmodel,unitab)
389 CALL hm_get_floatv('Beta_yy',beta_yy,is_available,lsubmodel,unitab)
390 CALL hm_get_floatv('Alpha_zz',alpha_zz,is_available,lsubmodel,unitab)
391 CALL hm_get_floatv('Beta_zz',beta_zz,is_available,lsubmodel,unitab)
392C--------------------------------------------------
393 dampr(19,i) = 0
394 dampr(20,i) = 0
395 dampr(21,i) = 0
396C--------------------------------------------------
397 ENDIF ! IF(KEY(1:5)=='INTER')THEN
398C
399 DO j=0,numskw+min(1,nspcond)*numsph+nsubmod
400 IF(isk == iskn(4,j+1)) THEN
401 isk=j+1
402 GO TO 100
403 ENDIF
404 ENDDO
405 CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
406 . c1='DAMP',
407 . c2='DAMP',
408 . i1=id,i2=isk,c3=titr)
409 100 CONTINUE
410
411C
412 IF (tstop == zero) tstop=ep30
413C
414 dampr(1,i) = id
415 IF (fl_freq_range == 0) THEN
416 ingr2usr => igrnod(1:ngrnod)%ID
417 igr = ngr2usr(jgrn,ingr2usr,ngrnod)
418 IF (igr == 0) THEN
419 CALL ancmsg(msgid=171,
420 . msgtype=msgerror,
421 . anmode=aninfo,
422 . c1='RAYLEIGH DAMPING',
423 . i1= id,
424 . c2= titr,
425 . c3='NODE',
426 . i2=jgrn)
427 ENDIF
428 ENDIF
429 dampr(2,i) = igr
430 dampr(3,i) = alpha
431 dampr(4,i) = beta
432 dampr(15,i) = isk
433 dampr(17,i) = tstart
434 dampr(18,i) = tstop
435!
436 dampr(21,i) = itype
437C
438 IF (.NOT. full_format) THEN
439C-- reduced format only for /DAMP and /DAMP/INTER
440 dampr(5,i) = alpha
441 dampr(6,i) = beta
442 dampr(7,i) = alpha
443 dampr(8,i) = beta
444 dampr(9,i) = alpha
445 dampr(10,i) = beta
446 dampr(11,i) = alpha
447 dampr(12,i) = beta
448 dampr(13,i) = alpha
449 dampr(14,i) = beta
450 IF (flint==1) THEN
451 dampr(3,i) = zero
452 dampr(4,i) = zero
453 dampr(5,i) = zero
454 dampr(6,i) = zero
455 dampr(7,i) = zero
456 dampr(8,i) = zero
457 ENDIF
458 WRITE (iout,1100) jgrn,alpha,beta,factb,tstart,tstop
459 ELSE
460 SELECT CASE (itype)
461 CASE(0) !/DAMP
462 flg_pri = 1
463 dampr(3,i) = alpha
464 dampr(4,i) = beta
465 dampr(5,i) = alpha_y
466 dampr(6,i) = beta_y
467 dampr(7,i) = alpha_z
468 dampr(8,i) = beta_z
469 dampr(9,i) = alpha_xx
470 dampr(10,i) = beta_xx
471 dampr(11,i) = alpha_yy
472 dampr(12,i) = beta_yy
473 dampr(13,i) = alpha_zz
474 dampr(14,i) = beta_zz
475 WRITE (iout,1200) jgrn,iskn(4,isk),
476 . alpha,beta,alpha_y,beta_y,alpha_z,beta_z,
477 . alpha_xx,beta_xx,alpha_yy,beta_yy,alpha_zz,beta_zz,
478 . tstart,tstop
479 CASE(1) !/DAMP/INTER
480 dampr(3,i) = zero
481 dampr(4,i) = zero
482 dampr(5,i) = zero
483 dampr(6,i) = zero
484 dampr(7,i) = zero
485 dampr(8,i) = zero
486 dampr(9,i) = alpha
487 dampr(10,i) = beta
488 dampr(11,i) = alpha_yy
489 dampr(12,i) = beta_yy
490 dampr(13,i) = alpha_zz
491 dampr(14,i) = beta_zz
492 WRITE (iout,1500) jgrn,iskn(4,isk),
493 . alpha,beta,alpha_yy,beta_yy,
494 . alpha_zz,beta_zz,tstart,tstop
495 CASE(2) !/DAMP/VREL
496 dampr(3,i) = cdamp_mx
497 dampr(4,i) = zero
498 dampr(5,i) = cdamp_my
499 dampr(6,i) = zero
500 dampr(7,i) = cdamp_mz
501 dampr(8,i) = zero
502 dampr(9,i) = zero
503 dampr(10,i) = zero
504 dampr(11,i) = zero
505 dampr(12,i) = zero
506 dampr(13,i) = zero
507 dampr(14,i) = zero
508 WRITE (iout,1800) jgrn,iskn(4,isk),rbody_id,func_id,
509 . cdamp_mx,cdamp_my,cdamp_mz,
510 . dv2_mx,dv2_my,dv2_mz,
511 . freq,tstart,tstop
512 dampr(28,i) = freq
513 dampr(29,i) = zero
514 dampr(30,i) = zero
515 CASE(3) !/DAMP/FREQUENCY_RANGE
516 WRITE (iout,2000) grpart,cdamp,freq_low,freq_high,tstart,tstop
517C Automatic computation of parameters of the 3 maxwell components
518 CALL damping_range_compute_param(cdamp,freq_low,freq_high,maxwell_alpha,maxwell_tau)
519C
520 dampr(31,i) = one
521 dampr(32:34,i) = maxwell_alpha(1:3)
522 dampr(35:37,i) = maxwell_tau(1:3)
523 CASE(4) !/DAMP/FUNCT
524 alpha_x = alpha
525 dampr(3,i) = alpha_x
526 alpha = factb
527 dampr(4,i) = beta
528 dampr(5,i) = alpha_y
529 dampr(7,i) = alpha_z
530 dampr(9,i) = alpha_xx
531 dampr(11,i) = alpha_yy
532 dampr(13,i) = alpha_zz
533 dampr(26,i) = ifun ! take care of IFUN in split
534 dampr(32,i) = alpha_x
535 dampr(33,i) = alpha_y
536 dampr(34,i) = alpha_z
537 dampr(35,i) = alpha_xx
538 dampr(36,i) = alpha_yy
539 dampr(37,i) = alpha_zz
540 WRITE (iout,2200) jgrn,ifun,alpha,
541 . alpha_x,alpha_y,alpha_z,
542 . alpha_xx,alpha_yy,alpha_zz
543 END SELECT
544 END IF !(.NOT. FULL_FORMAT) THEN
545 dampr(16,i) = factb
546 END DO ! NDAMP
547C---
548 RETURN
549
550 1000 FORMAT(//
551 .' RAYLEIGH DAMPING '/
552 . ' ---------------------- ')
553 1100 FORMAT( 8x,'NODE GROUP ID . . . . . . . . .',i10
554 . /10x,'ALPHA. . . . . . . . . . . . . .',1pg20.13
555 . /10x,'BETA . . . . . . . . . . . . . .',1pg20.13
556 . /10x,'MAX TIME STEP FACTOR . . . . . .',1pg20.13
557 . /10x,'START TIME . . . . . . . . . . .',1pg20.13
558 . /10x,'STOP TIME . . . . . . . . . . .',1pg20.13)
559 1200 FORMAT( 10x,'NODE GROUP ID . . . . . . . . .',i10
560 . /10x,'SKEW ID . . . . . . . . . . .',i10
561 . /10x,'ALPHA IN X-DIRECTION. . . . . .',1pg20.13
562 . /10x,'BETA IN X-DIRECTION. . . . . .',1pg20.13
563 . /10x,'ALPHA IN Y-DIRECTION. . . . . .',1pg20.13
564 . /10x,'BETA IN Y-DIRECTION. . . . . .',1pg20.13
565 . /10x,'ALPHA IN Z-DIRECTION. . . . . .',1pg20.13
566 . /10x,'BETA IN Z-DIRECTION. . . . . .',1pg20.13
567 . /10x,'ALPHA IN RX-DIRECTION . . . . .',1pg20.13
568 . /10x,'BETA IN RX-DIRECTION . . . . .',1pg20.13
569 . /10x,'ALPHA IN RY-DIRECTION . . . . .',1pg20.13
570 . /10x,'BETA IN RY-DIRECTION . . . . .',1pg20.13
571 . /10x,'ALPHA IN RZ-DIRECTION . . . . .',1pg20.13
572 . /10x,'BETA IN RZ-DIRECTION . . . . .',1pg20.13
573 . /10x,'START TIME . . . . . . . . . . .',1pg20.13
574 . /10x,'STOP TIME . . . . . . . . . . .',1pg20.13)
575 1300 FORMAT(/,10x,'SELECTIVE RAYLEIGH DAMPING ON CONTACT NODES')
576 1400 FORMAT( 10x,'NUMBER OF TIME STEP . . . . . .',i10,/)
577 1500 FORMAT( 10x,'NODE GROUP ID . . . . . . . . .',i10
578 . /10x,'SKEW ID . . . . . . . . . . .',i10
579 . /10x,'ALPHA IN RX-DIRECTION . . . . .',1pg20.13
580 . /10x,'BETA IN RX-DIRECTION . . . . .',1pg20.13
581 . /10x,'ALPHA IN RY-DIRECTION . . . . .',1pg20.13
582 . /10x,'BETA IN RY-DIRECTION . . . . .',1pg20.13
583 . /10x,'ALPHA IN RZ-DIRECTION . . . . .',1pg20.13
584 . /10x,'BETA IN RZ-DIRECTION . . . . .',1pg20.13
585 . /10x,'START TIME . . . . . . . . . . .',1pg20.13
586 . /10x,'STOP TIME . . . . . . . . . . .',1pg20.13)
587 1600 FORMAT( 10x,'EXTENSION OF NODES SELECTION . ',i10,/)
588 1700 FORMAT(/,10x,'RAYLEIGH DAMPING WITH RELATIVE VELOCITIES')
589 1800 FORMAT( 10x,'NODE GROUP ID . . . . . . . . .',i10
590 . /10x,'SKEW ID . . . . . . . . . . . .',i10
591 . /10x,'RBODY ID . . . . . . . . . . . ',i10
592 . /10x,'DAMPING FUNCTION ID . . . . . .',i10
593 . /10x,'mass damping coefficient in x-direction. . . . . .',1PG20.13
594 . /10X,'mass damping coefficient in y-direction. . . . . .',1PG20.13
595 . /10X,'mass damping coefficient in z-direction. . . . . .',1PG20.13
596 . /10X,'quadratic mass damping coefficient in x-direction.',1PG20.13
597 . /10X,'quadratic mass damping coefficient in y-direction.',1PG20.13
598 . /10X,'quadratic mass damping coefficient in z-direction.',1PG20.13
599 . /10X,'damping frequency . . . . . . . . . . . . . . . . ',1PG20.13
600 . /10X,'start time . . . . . . . . . . . . . . . . . . . .',1PG20.13
601 . /10X,'stop time . . . . . . . . . . . . . . . . . . . .',1PG20.13)
602 1900 FORMAT(/,10X,'damping over frequency range')
603 2000 FORMAT( 10X,'part group id . . . . . . . . .',I10
604 . /10X,'damping ratio . . . . . . . . . . . . . . . . . . ',1PG20.13
605 . /10X,'lowest frequency . . . . . . . . . . . . . . . . .',1PG20.13
606 . /10X,'highest frequency. . . . . . . . . . . . . . . . .',1PG20.13
607 . /10X,'start time . . . . . . . . . . . . . . . . . . . .',1PG20.13
608 . /10X,'stop time . . . . . . . . . . . . . . . . . . . .',1PG20.13)
609 2100 FORMAT(/,10X,'mass damping with input function')
610 2200 FORMAT( 10X,'node group id . . . . . . . . . . . . . . . . . .',I10
611 . /10X,'alpha FUNCTION id . . . . . . . . . . . . . . . .',I10
612 . /10X,'alpha function ordinate scale factor . . . . . . ',1PG20.13
613 . /10X,'mass damping coefficient in x-direction. . . . . ',1PG20.13
614 . /10X,'mass damping coefficient in y-direction. . . . . ',1PG20.13
615 . /10X,'mass damping coefficient in z-direction. . . . . ',1PG20.13
616 . /10X,'mass damping coefficient in rx-direction. . . . .',1PG20.13
617 . /10X,'mass damping coefficient in ry-direction. . . . .',1PG20.13
618 . /10X,'mass damping coefficient in rz-direction. . . . .',1PG20.13)
619C---
620 RETURN
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
alpha
#define alpha
Definition eval.h:35
hm_get_boolv
subroutine hm_get_boolv(name, bval, is_available)
Definition hm_get_boolv.F:34
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_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
min
#define min(a, b)
Definition macros.h:20
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:668
hm_option_read_mod
Definition hm_option_read_mod.F:412
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
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725
unitab_mod
Definition unitab_mod.F:517
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:323
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