OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_damp.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_damp ../starter/source/general_controls/damping/hm_read_damp.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| damping_range_compute_param ../starter/source/general_controls/damping/damping_range_compute_param.F90
30!|| hm_get_boolv ../starter/source/devtools/hm_reader/hm_get_boolv.F
31!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
32!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
33!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
34!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
35!|| ngr2usr ../starter/source/system/nintrr.F
36!||--- uses -----------------------------------------------------
37!|| damping_range_compute_param_mod ../starter/source/general_controls/damping/damping_range_compute_param.F90
38!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
39!|| message_mod ../starter/share/message_module/message_mod.F
40!|| submodel_mod ../starter/share/modules1/submodel_mod.F
41!||====================================================================
42 SUBROUTINE hm_read_damp(DAMPR,IGRNOD, ISKN,LSUBMODEL,UNITAB,
43 . SNPC1,NPC1,NDAMP_VREL_RBY,IGRPART,DAMP_RANGE_PART)
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,USR_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
170C
171 IF(key(1:5)=='INTER')THEN
172 flint = 1
173 itype = 1
174 CALL hm_get_intv('Nb_time_step',nb_pas,is_available,lsubmodel)
175 CALL hm_get_intv('Range',range,is_available,lsubmodel)
176 CALL hm_get_intv('grnod_id',jgrn,is_available,lsubmodel)
177 CALL hm_get_intv('skew_id',isk,is_available,lsubmodel)
178 IF(isk == 0 .AND. sub_index /= 0 ) isk = lsubmodel(sub_index)%SKEW
179 CALL hm_get_boolv('Mass_Damp_Factor_Option',full_format,is_available)
180C--------------------------------------------------
181C EXTRACT DATAS (REAL VALUES)
182C--------------------------------------------------
183 CALL hm_get_floatv('Alpha',alpha,is_available,lsubmodel,unitab)
184 CALL hm_get_floatv('Beta',beta,is_available,lsubmodel,unitab)
185 CALL hm_get_floatv('Tstart',tstart,is_available,lsubmodel,unitab)
186 CALL hm_get_floatv('Tstop',tstop,is_available,lsubmodel,unitab)
187 CALL hm_get_floatv('Alpha_yy',alpha_yy,is_available,lsubmodel,unitab)
188 CALL hm_get_floatv('Beta_yy',beta_yy,is_available,lsubmodel,unitab)
189 CALL hm_get_floatv('Alpha_zz',alpha_zz,is_available,lsubmodel,unitab)
190 CALL hm_get_floatv('Beta_zz',beta_zz,is_available,lsubmodel,unitab)
191C--------------------------------------------------
192 IF (nb_pas == 0) nb_pas = 20
193 WRITE(iout,1300)
194 WRITE(iout,1400) nb_pas
195 WRITE(iout,1600) range
196 idamp_rdof = idamp_rdof+1
197 kcontact = 1
198 dampr(19,i) = nb_pas
199 dampr(20,i) = range
200 dampr(21,i) = 0
201 ELSEIF(key(1:4).EQ.'VREL')THEN
202 fl_vrel = 1
203 itype = 2
204C--------------------------------------------------
205C EXTRACT DATAS (INTEGER VALUES)
206C--------------------------------------------------
207 CALL hm_get_intv('grnod_id',jgrn,is_available,lsubmodel)
208 CALL hm_get_intv('skew_id',isk,is_available,lsubmodel)
209 IF(isk == 0 .AND. sub_index .NE. 0 ) isk = lsubmodel(sub_index)%SKEW
210 CALL hm_get_intv('RbodyID',rbody_id,is_available,lsubmodel)
211 CALL hm_get_intv('FuncID',func_id,is_available,lsubmodel)
212C--------------------------------------------------
213C EXTRACT DATAS (REAL VALUES)
214C--------------------------------------------------
215 CALL hm_get_floatv('Tstart',tstart,is_available,lsubmodel,unitab)
216 CALL hm_get_floatv('Tstop',tstop,is_available,lsubmodel,unitab)
217 CALL hm_get_floatv('Freq',freq,is_available,lsubmodel,unitab)
218 CALL hm_get_floatv('Xscale',xscale,is_available,lsubmodel,unitab)
219 CALL hm_get_floatv('Alpha_x',cdamp_mx,is_available,lsubmodel,unitab)
220 CALL hm_get_floatv('Alpha_y',cdamp_my,is_available,lsubmodel,unitab)
221 CALL hm_get_floatv('Alpha_z',cdamp_mz,is_available,lsubmodel,unitab)
222 CALL hm_get_floatv('Alpha2_x',dv2_mx,is_available,lsubmodel,unitab)
223 CALL hm_get_floatv('Alpha2_y',dv2_my,is_available,lsubmodel,unitab)
224 CALL hm_get_floatv('Alpha2_z',dv2_mz,is_available,lsubmodel,unitab)
225C--------------------------------------------------
226 IF (cdamp_my == zero) cdamp_my = cdamp_mx
227 IF (cdamp_mz == zero) cdamp_mz = cdamp_mx
228 IF (dv2_my == zero) dv2_my = dv2_mx
229 IF (dv2_mz == zero) dv2_mz = dv2_mx
230 IF (xscale == zero) xscale = one
231 alpha = zero
232 beta = zero
233C---------RBODY ----------------------------
234 IF (rbody_id /= 0) THEN
235 ndamp_vrel_rby = ndamp_vrel_rby + 1
236C RBODY merge - user ID of RBY is stored in DAMPR-> change to user id done after
237 ENDIF
238C---------FUNC ID user-----------------------------
239 ifun=0
240 IF (func_id /= 0) THEN
241 DO j=1,nfunct
242 IF (func_id == npc1(j)) THEN
243 ifun=j
244 EXIT
245 ENDIF
246 ENDDO
247 IF (ifun == 0)THEN ! Function not found
248 CALL ancmsg(msgid=3049,
249 . msgtype=msgerror,
250 . anmode=aninfo,
251 . i1=id,
252 . c1=titr,
253 . i2=func_id)
254 ENDIF
255 ENDIF
256C--------------------------------------------------
257 WRITE(iout,1700)
258 dampr(19,i) = 0
259 dampr(20,i) = 0
260 dampr(21,i) = 1
261 dampr(22,i) = dv2_mx
262 dampr(23,i) = dv2_my
263 dampr(24,i) = dv2_mz
264 dampr(25,i) = rbody_id
265 dampr(26,i) = ifun
266 dampr(27,i) = xscale
267 full_format = .true.
268C--------------------------------------------------
269 ELSEIF(key(1:4).EQ.'FREQ')THEN
270C--------------------------------------------------
271C Dapming in frequency range
272C--------------------------------------------------
273 itype = 3
274 fl_freq_range = 1
275C--------------------------------------------------
276C EXTRACT DATAS (INTEGER VALUES)
277C--------------------------------------------------
278 CALL hm_get_intv('grpart_id',grpart,is_available,lsubmodel)
279C---------Check part Id-----------------------------
280 IF(grpart/=0)THEN
281 igr = 0
282 DO j=1,ngrpart
283 IF (igrpart(j)%ID == grpart) THEN
284 igr=j
285 EXIT
286 END IF
287 END DO
288 IF(igr == 0) THEN
289 CALL ancmsg(msgid=3086,
290 . msgtype=msgerror,
291 . anmode=aninfo_blind_1,
292 . i1=id,
293 . c1=titr,
294 . i2=grpart)
295 ENDIF
296C---------Tag of the parts-----------------------------
297 DO j=1,igrpart(igr)%NENTITY
298 damp_range_part(igrpart(igr)%ENTITY(j)) = i
299 ENDDO
300 ELSE
301C---------Tag of all parts-----------------------------
302 DO j=1,npart
303 damp_range_part(j) = i
304 ENDDO
305 ENDIF
306 WRITE(iout,1900)
307 isk = 0
308 full_format = .true.
309 alpha = zero
310 beta = zero
311C--------------------------------------------------
312C EXTRACT DATAS (REAL VALUES)
313C--------------------------------------------------
314 CALL hm_get_floatv('Cdamp',cdamp,is_available,lsubmodel,unitab)
315 CALL hm_get_floatv('Tstart',tstart,is_available,lsubmodel,unitab)
316 CALL hm_get_floatv('Tstop',tstop,is_available,lsubmodel,unitab)
317 CALL hm_get_floatv('Freq_low',freq_low,is_available,lsubmodel,unitab)
318 CALL hm_get_floatv('Freq_high',freq_high,is_available,lsubmodel,unitab)
319C--------------------------------------------------
320 ELSEIF(key(1:5).EQ.'FUNCT')THEN
321C--------------------------------------------------
322 itype = 4
323C--------------------------------------------------
324C EXTRACT DATAS (INTEGER VALUES)
325C--------------------------------------------------
326 CALL hm_get_intv('grnod_id',jgrn,is_available,lsubmodel)
327 CALL hm_get_intv('FuncID',func_id,is_available,lsubmodel)
328C--------------------------------------------------
329C EXTRACT DATAS (REAL VALUES)
330C--------------------------------------------------
331 CALL hm_get_floatv('Alpha',alpha,is_available,lsubmodel,unitab)
332 CALL hm_get_floatv('Alpha_x',alpha_x,is_available,lsubmodel,unitab)
333 CALL hm_get_floatv('Alpha_y',alpha_y,is_available,lsubmodel,unitab)
334 CALL hm_get_floatv('Alpha_z',alpha_z,is_available,lsubmodel,unitab)
335 CALL hm_get_floatv('Alpha_xx',alpha_xx,is_available,lsubmodel,unitab)
336 CALL hm_get_floatv('Alpha_yy',alpha_yy,is_available,lsubmodel,unitab)
337 CALL hm_get_floatv('Alpha_zz',alpha_zz,is_available,lsubmodel,unitab)
338 isk = 0
339 tstart = zero
340 tstop=ep30
341 full_format = .true.
342 IF (alpha==zero) alpha = one ! default =1 to add in manual
343 factb = alpha
344 alpha = alpha_x
345!---------FUNC ID user-----------------------------
346 ifun=0
347 IF (func_id /= 0) THEN
348 DO j=1,nfunct
349 IF (func_id == npc1(j)) THEN
350 ifun=j
351 EXIT
352 ENDIF
353 ENDDO
354 IF (ifun == 0)THEN ! Function not found
355 CALL ancmsg(msgid=3049,
356 . msgtype=msgerror,
357 . anmode=aninfo,
358 . i1=id,
359 . c1=titr,
360 . i2=func_id)
361 ENDIF
362 ENDIF
363 dampr(4:nrdamp,i) = zero
364 WRITE(iout,2100)
365 ELSE
366C--------------------------------------------------
367C EXTRACT DATAS (INTEGER VALUES)
368C--------------------------------------------------
369 CALL hm_get_intv('grnod_id',jgrn,is_available,lsubmodel)
370 CALL hm_get_intv('skew_id',isk,is_available,lsubmodel)
371 IF(isk == 0 .AND. sub_index /= 0 ) isk = lsubmodel(sub_index)%SKEW
372 CALL hm_get_boolv('Mass_Damp_Factor_Option',full_format,is_available)
373C--------------------------------------------------
374C EXTRACT DATAS (REAL VALUES)
375C--------------------------------------------------
376 CALL hm_get_floatv('Alpha',alpha,is_available,lsubmodel,unitab)
377 CALL hm_get_floatv('Beta',beta,is_available,lsubmodel,unitab)
378 CALL hm_get_floatv('Tstart',tstart,is_available,lsubmodel,unitab)
379 CALL hm_get_floatv('Tstop',tstop,is_available,lsubmodel,unitab)
380 CALL hm_get_floatv('Alpha_y',alpha_y,is_available,lsubmodel,unitab)
381 CALL hm_get_floatv('Beta_y',beta_y,is_available,lsubmodel,unitab)
382 CALL hm_get_floatv('Alpha_z',alpha_z,is_available,lsubmodel,unitab)
383 CALL hm_get_floatv('Beta_z',beta_z,is_available,lsubmodel,unitab)
384 CALL hm_get_floatv('Alpha_xx',alpha_xx,is_available,lsubmodel,unitab)
385 CALL hm_get_floatv('Beta_xx',beta_xx,is_available,lsubmodel,unitab)
386 CALL hm_get_floatv('Alpha_yy',alpha_yy,is_available,lsubmodel,unitab)
387 CALL hm_get_floatv('Beta_yy',beta_yy,is_available,lsubmodel,unitab)
388 CALL hm_get_floatv('Alpha_zz',alpha_zz,is_available,lsubmodel,unitab)
389 CALL hm_get_floatv('Beta_zz',beta_zz,is_available,lsubmodel,unitab)
390C--------------------------------------------------
391 dampr(19,i) = 0
392 dampr(20,i) = 0
393 dampr(21,i) = 0
394C--------------------------------------------------
395 ENDIF ! IF(KEY(1:5)=='INTER')THEN
396C
397 DO j=0,numskw+min(1,nspcond)*numsph+nsubmod
398 IF(isk == iskn(4,j+1)) THEN
399 isk=j+1
400 GO TO 100
401 ENDIF
402 ENDDO
403 CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
404 . c1='DAMP',
405 . c2='DAMP',
406 . i1=id,i2=isk,c3=titr)
407 100 CONTINUE
408
409C
410 IF (tstop == zero) tstop=ep30
411C
412 dampr(1,i) = id
413 IF (fl_freq_range == 0) THEN
414 ingr2usr => igrnod(1:ngrnod)%ID
415 igr = ngr2usr(jgrn,ingr2usr,ngrnod)
416 IF (igr == 0) THEN
417 CALL ancmsg(msgid=171,
418 . msgtype=msgerror,
419 . anmode=aninfo,
420 . c1='rayleigh damping',
421 . I1= ID,
422 . C2= TITR,
423 . C3='node',
424 . I2=JGRN)
425 ENDIF
426 ENDIF
427 DAMPR(2,I) = IGR
428 DAMPR(3,I) = ALPHA
429 DAMPR(4,I) = BETA
430 DAMPR(15,I) = ISK
431 DAMPR(17,I) = TSTART
432 DAMPR(18,I) = TSTOP
433!
434 DAMPR(21,I) = ITYPE
435C
436.NOT. IF ( FULL_FORMAT) THEN
437C-- reduced format only for /DAMP and /DAMP/INTER
438 DAMPR(5,I) = ALPHA
439 DAMPR(6,I) = BETA
440 DAMPR(7,I) = ALPHA
441 DAMPR(8,I) = BETA
442 DAMPR(9,I) = ALPHA
443 DAMPR(10,I) = BETA
444 DAMPR(11,I) = ALPHA
445 DAMPR(12,I) = BETA
446 DAMPR(13,I) = ALPHA
447 DAMPR(14,I) = BETA
448 IF (FLINT==1) THEN
449 DAMPR(3,I) = ZERO
450 DAMPR(4,I) = ZERO
451 DAMPR(5,I) = ZERO
452 DAMPR(6,I) = ZERO
453 DAMPR(7,I) = ZERO
454 DAMPR(8,I) = ZERO
455 ENDIF
456 WRITE (IOUT,1100) JGRN,ALPHA,BETA,FACTB,TSTART,TSTOP
457 ELSE
458 SELECT CASE (ITYPE)
459 CASE(0) !/DAMP
460 FLG_PRI = 1
461 DAMPR(3,I) = ALPHA
462 DAMPR(4,I) = BETA
463 DAMPR(5,I) = ALPHA_Y
464 DAMPR(6,I) = BETA_Y
465 DAMPR(7,I) = ALPHA_Z
466 DAMPR(8,I) = BETA_Z
467 DAMPR(9,I) = ALPHA_XX
468 DAMPR(10,I) = BETA_XX
469 DAMPR(11,I) = ALPHA_YY
470 DAMPR(12,I) = BETA_YY
471 DAMPR(13,I) = ALPHA_ZZ
472 DAMPR(14,I) = BETA_ZZ
473 WRITE (IOUT,1200) JGRN,ISKN(4,ISK),
474 . ALPHA,BETA,ALPHA_Y,BETA_Y,ALPHA_Z,BETA_Z,
475 . ALPHA_XX,BETA_XX,ALPHA_YY,BETA_YY,ALPHA_ZZ,BETA_ZZ,
476 . TSTART,TSTOP
477 CASE(1) !/DAMP/INTER
478 DAMPR(3,I) = ZERO
479 DAMPR(4,I) = ZERO
480 DAMPR(5,I) = ZERO
481 DAMPR(6,I) = ZERO
482 DAMPR(7,I) = ZERO
483 DAMPR(8,I) = ZERO
484 DAMPR(9,I) = ALPHA
485 DAMPR(10,I) = BETA
486 DAMPR(11,I) = ALPHA_YY
487 DAMPR(12,I) = BETA_YY
488 DAMPR(13,I) = ALPHA_ZZ
489 DAMPR(14,I) = BETA_ZZ
490 WRITE (IOUT,1500) JGRN,ISKN(4,ISK),
491 . ALPHA,BETA,ALPHA_YY,BETA_YY,
492 . ALPHA_ZZ,BETA_ZZ,TSTART,TSTOP
493 CASE(2) !/DAMP/VREL
494 DAMPR(3,I) = CDAMP_MX
495 DAMPR(4,I) = ZERO
496 DAMPR(5,I) = CDAMP_MY
497 DAMPR(6,I) = ZERO
498 DAMPR(7,I) = CDAMP_MZ
499 DAMPR(8,I) = ZERO
500 DAMPR(9,I) = ZERO
501 DAMPR(10,I) = ZERO
502 DAMPR(11,I) = ZERO
503 DAMPR(12,I) = ZERO
504 DAMPR(13,I) = ZERO
505 DAMPR(14,I) = ZERO
506 WRITE (IOUT,1800) JGRN,ISKN(4,ISK),RBODY_ID,FUNC_ID,
507 . CDAMP_MX,CDAMP_MY,CDAMP_MZ,
508 . DV2_MX,DV2_MY,DV2_MZ,
509 . FREQ,TSTART,TSTOP
510 DAMPR(28,I) = FREQ
511 DAMPR(29,I) = ZERO
512 DAMPR(30,I) = ZERO
513 CASE(3) !/DAMP/FREQUENCY_RANGE
514 WRITE (IOUT,2000) GRPART,CDAMP,FREQ_LOW,FREQ_HIGH,TSTART,TSTOP
515C Automatic computation of parameters of the 3 maxwell components
516 CALL damping_range_compute_param(CDAMP,FREQ_LOW,FREQ_HIGH,MAXWELL_ALPHA,MAXWELL_TAU)
517C
518 DAMPR(31,I) = ONE
519 DAMPR(32:34,I) = MAXWELL_ALPHA(1:3)
520 DAMPR(35:37,I) = MAXWELL_TAU(1:3)
521 CASE(4) !/DAMP/FUNCT
522 ALPHA_X = ALPHA
523 DAMPR(3,I) = ALPHA_X
524 ALPHA = FACTB
525 DAMPR(5,I) = ALPHA_Y
526 DAMPR(7,I) = ALPHA_Z
527 DAMPR(9,I) = ALPHA_XX
528 DAMPR(11,I) = ALPHA_YY
529 DAMPR(13,I) = ALPHA_ZZ
530 DAMPR(26,I) = IFUN ! take care of IFUN in split
531 DAMPR(32,I) = ALPHA_X
532 DAMPR(33,I) = ALPHA_Y
533 DAMPR(34,I) = ALPHA_Z
534 DAMPR(35,I) = ALPHA_XX
535 DAMPR(36,I) = ALPHA_YY
536 DAMPR(37,I) = ALPHA_ZZ
537 WRITE (IOUT,2200) JGRN,IFUN,ALPHA,
538 . ALPHA_X,ALPHA_Y,ALPHA_Z,
539 . ALPHA_XX,ALPHA_YY,ALPHA_ZZ
540 END SELECT
541.NOT. END IF !( FULL_FORMAT) THEN
542 DAMPR(16,I) = FACTB
543 END DO ! NDAMP
544C---
545 RETURN
546
547 1000 FORMAT(//
548 .' rayleigh damping '/
549 . ' ---------------------- ')
550 1100 FORMAT( 8X,'node group id . . . . . . . . .',I10
551 . /10X,'alpha. . . . . . . . . . . . . .',1PG20.13
552 . /10X,'beta . . . . . . . . . . . . . .',1PG20.13
553 . /10X,'max time step factor . . . . . .',1PG20.13
554 . /10X,'start time . . . . . . . . . . .',1PG20.13
555 . /10X,'stop time . . . . . . . . . . .',1PG20.13)
556 1200 FORMAT( 10X,'node group id . . . . . . . . .',I10
557 . /10X,'skew id . . . . . . . . . . .',I10
558 . /10X,'alpha in x-direction. . . . . .',1PG20.13
559 . /10X,'beta in x-direction. . . . . .',1PG20.13
560 . /10X,'alpha in y-direction. . . . . .',1PG20.13
561 . /10X,'beta in y-direction. . . . . .',1PG20.13
562 . /10X,'alpha in z-direction. . . . . .',1PG20.13
563 . /10X,'beta in z-direction. . . . . .',1PG20.13
564 . /10X,'alpha in rx-direction . . . . .',1PG20.13
565 . /10X,'beta in rx-direction . . . . .',1PG20.13
566 . /10X,'alpha in ry-direction . . . . .',1PG20.13
567 . /10X,'beta in ry-direction . . . . .',1PG20.13
568 . /10X,'alpha in rz-direction . . . . .',1PG20.13
569 . /10X,'beta in rz-direction . . . . .',1PG20.13
570 . /10X,'start time . . . . . . . . . . .',1PG20.13
571 . /10X,'stop time . . . . . . . . . . .',1PG20.13)
572 1300 FORMAT(/,10X,'selective rayleigh damping on contact nodes')
573 1400 FORMAT( 10X,'number of time step . . . . . .',I10,/)
574 1500 FORMAT( 10X,'node group id . . . . . . . . .',I10
575 . /10X,'skew id . . . . . . . . . . .',I10
576 . /10X,'alpha in rx-direction . . . . .',1PG20.13
577 . /10X,'beta in rx-direction . . . . .',1PG20.13
578 . /10X,'alpha in ry-direction . . . . .',1PG20.13
579 . /10X,'beta in ry-direction . . . . .',1PG20.13
580 . /10X,'alpha in rz-direction . . . . .',1PG20.13
581 . /10X,'beta in rz-direction . . . . .',1PG20.13
582 . /10X,'start time . . . . . . . . . . .',1PG20.13
583 . /10X,'stop time . . . . . . . . . . .',1PG20.13)
584 1600 FORMAT( 10X,'extension of nodes selection . ',I10,/)
585 1700 FORMAT(/,10X,'rayleigh damping with relative velocities')
586 1800 FORMAT( 10X,'node group id . . . . . . . . .',I10
587 . /10X,'skew id . . . . . . . . . . . .',I10
588 . /10X,'rbody id . . . . . . . . . . . ',i10
589 . /10x,'DAMPING FUNCTION ID . . . . . .',i10
590 . /10x,'MASS DAMPING COEFFICIENT IN X-DIRECTION. . . . . .',1pg20.13
591 . /10x,'MASS DAMPING COEFFICIENT IN Y-DIRECTION. . . . . .',1pg20.13
592 . /10x,'MASS DAMPING COEFFICIENT IN Z-DIRECTION. . . . . .',1pg20.13
593 . /10x,'QUADRATIC MASS DAMPING COEFFICIENT IN X-DIRECTION.',1pg20.13
594 . /10x,'QUADRATIC MASS DAMPING COEFFICIENT IN Y-DIRECTION.',1pg20.13
595 . /10x,'QUADRATIC MASS DAMPING COEFFICIENT IN Z-DIRECTION.',1pg20.13
596 . /10x,'DAMPING FREQUENCY . . . . . . . . . . . . . . . . ',1pg20.13
597 . /10x,'START TIME . . . . . . . . . . . . . . . . . . . .',1pg20.13
598 . /10x,'STOP TIME . . . . . . . . . . . . . . . . . . . .',1pg20.13)
599 1900 FORMAT(/,10x,'DAMPING OVER FREQUENCY RANGE')
600 2000 FORMAT( 10x,'PART GROUP ID . . . . . . . . .',i10
601 . /10x,'DAMPING RATIO . . . . . . . . . . . . . . . . . . ',1pg20.13
602 . /10x,'LOWEST FREQUENCY . . . . . . . . . . . . . . . . .',1pg20.13
603 . /10x,'HIGHEST FREQUENCY. . . . . . . . . . . . . . . . .',1pg20.13
604 . /10x,'START TIME . . . . . . . . . . . . . . . . . . . .',1pg20.13
605 . /10x,'STOP TIME . . . . . . . . . . . . . . . . . . . .',1pg20.13)
606 2100 FORMAT(/,10x,'MASS DAMPING WITH INPUT FUNCTION')
607 2200 FORMAT( 10x,'NODE GROUP ID . . . . . . . . . . . . . . . . . .',i10
608 . /10x,'ALPHA FUNCTION ID . . . . . . . . . . . . . . . .',i10
609 . /10x,'ALPHA FUNCTION ORDINATE SCALE FACTOR . . . . . . ',1pg20.13
610 . /10x,'MASS DAMPING COEFFICIENT IN X-DIRECTION. . . . . ',1pg20.13
611 . /10x,'MASS DAMPING COEFFICIENT IN Y-DIRECTION. . . . . ',1pg20.13
612 . /10x,'MASS DAMPING COEFFICIENT IN Z-DIRECTION. . . . . ',1pg20.13
613 . /10x,'MASS DAMPING COEFFICIENT IN RX-DIRECTION. . . . .',1pg20.13
614 . /10x,'MASS DAMPING COEFFICIENT IN RY-DIRECTION. . . . .',1pg20.13
615 . /10x,'MASS DAMPING COEFFICIENT IN RZ-DIRECTION. . . . .',1pg20.13)
616C---
617 RETURN
618 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
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:415
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_read_damp
subroutine hm_read_damp(dampr, igrnod, iskn, lsubmodel, unitab, snpc1, npc1, ndamp_vrel_rby, igrpart, damp_range_part)
Definition hm_read_damp.F:44
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
groupdef_mod
Definition groupdef_mod.F:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
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
submodel_mod
Definition submodel_mod.F:712
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
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
submodel_mod::submodel_data
Definition submodel_mod.F:723