43 . SNPC1,NPC1,NDAMP_VREL_RBY,IGRPART,DAMP_RANGE_PART)
53 USE damping_range_compute_param_mod
57#include "implicit_f.inc"
69 TYPE (UNIT_TYPE_),
INTENT(IN) ::UNITAB
72 INTEGER,
INTENT(IN) :: SNPC1,NPC1(SNPC1)
73 INTEGER,
INTENT(INOUT) :: NDAMP_VREL_RBY
75 INTEGER,
INTENT(INOUT) :: DAMP_RANGE_PART(NPART)
77 TYPE (GROUP_) ,
TARGET,
DIMENSION(NGRNOD) :: IGRNOD
78 TYPE (GROUP_) ,
DIMENSION(NGRPART) :: IGRPART
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
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
98 INTEGER,
DIMENSION(:),
POINTER :: INGR2USR
123! itype now -> 0:/damp; 1:/damp/inter 2:/damp/vrel 3:/damp/freq 4:/damp/funct
137 is_available = .false.
152 . option_titr = titr,
153 . submodel_index = sub_index,
155 full_format = .false.
173 IF(key(1:5)==
'INTER')
THEN
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)
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)
194 IF (nb_pas == 0) nb_pas = 20
196 WRITE(iout,1400) nb_pas
197 WRITE(iout,1600) range
198 idamp_rdof = idamp_rdof+1
203 ELSEIF(key(1:4).EQ.
'VREL')
THEN
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)
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)
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
236 IF (RBODY_ID /= 0) THEN
237 NDAMP_VREL_RBY = NDAMP_VREL_RBY + 1
242 IF (FUNC_ID /= 0) THEN
244 IF (FUNC_ID == NPC1(J)) THEN
249 IF (IFUN == 0)THEN ! Function not found
250 CALL ANCMSG(MSGID=3049,
266 DAMPR(25,I) = RBODY_ID
271.EQ.
ELSEIF(KEY(1:4)'freq
')THEN
280 CALL HM_GET_INTV('grpart_id
',GRPART,IS_AVAILABLE,LSUBMODEL)
285 IF (IGRPART(J)%ID == GRPART) THEN
291 CALL ANCMSG(MSGID=3086,
293 . ANMODE=ANINFO_BLIND_1,
299 DO J=1,IGRPART(IGR)%NENTITY
300 DAMP_RANGE_PART(IGRPART(IGR)%ENTITY(J)) = I
305 DAMP_RANGE_PART(J) = I
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)
322.EQ.
ELSEIF(KEY(1:5)'funct
')THEN
328 CALL HM_GET_INTV('grnod_id
',JGRN,IS_AVAILABLE,LSUBMODEL)
329 CALL HM_GET_INTV('funcid
',FUNC_ID,IS_AVAILABLE,LSUBMODEL)
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)
344 IF (ALPHA==ZERO) ALPHA = ONE ! default =1 to add in manual
347!---------FUNC ID user-----------------------------
349 IF (FUNC_ID /= 0) THEN
351 IF (FUNC_ID == NPC1(J)) THEN
356 IF (IFUN == 0)THEN ! Function not found
357 CALL ANCMSG(MSGID=3049,
365 DAMPR(4:NRDAMP,I) = ZERO
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)
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)
397 ENDIF ! IF(KEY(1:5)=='inter
')THEN
399 DO J=0,NUMSKW+MIN(1,NSPCOND)*NUMSPH+NSUBMOD
400 IF(ISK == ISKN(4,J+1)) THEN
405 CALL ANCMSG(MSGID=137,ANMODE=ANINFO,MSGTYPE=MSGERROR,
408 . I1=ID,I2=ISK,C3=TITR)
412 IF (TSTOP == ZERO) TSTOP=EP30
415 IF (FL_FREQ_RANGE == 0) THEN
416 INGR2USR => IGRNOD(1:NGRNOD)%ID
417 IGR = NGR2USR(JGRN,INGR2USR,NGRNOD)
419 CALL ANCMSG(MSGID=171,
438.NOT.
IF ( FULL_FORMAT) THEN
458 WRITE (IOUT,1100) JGRN,ALPHA,BETA,FACTB,TSTART,TSTOP
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,
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
496 DAMPR(3,I) = CDAMP_MX
498 DAMPR(5,I) = CDAMP_MY
500 DAMPR(7,I) = CDAMP_MZ
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,
515 CASE(3) !/DAMP/FREQUENCY_RANGE
516 WRITE (IOUT,2000) GRPART,CDAMP,FREQ_LOW,FREQ_HIGH,TSTART,TSTOP
518 CALL damping_range_compute_param(CDAMP,FREQ_LOW,FREQ_HIGH,MAXWELL_ALPHA,MAXWELL_TAU)
521 DAMPR(32:34,I) = MAXWELL_ALPHA(1:3)
522 DAMPR(35:37,I) = MAXWELL_TAU(1:3)
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
544.NOT.
END IF !( FULL_FORMAT) THEN
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
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)