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
51 USE unitab_mod
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
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.EQ. ELSEIF(KEY(1:4)'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.EQ. ELSEIF(KEY(1:5)'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.AND. IF(ISK == 0 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.NOT. IF ( 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.NOT. END IF !( 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
621 END
#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
#define alpha
Definition eval.h:35
subroutine hm_get_boolv(name, bval, is_available)
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_start(entity_type)
subroutine hm_read_damp(dampr, igrnod, iskn, lsubmodel, unitab, snpc1, npc1, ndamp_vrel_rby, igrpart, damp_range_part)
#define max(a, b)
Definition macros.h:21
integer, parameter nchartitle