1 : C AMOR SOURCE FANDEUR 11/07/19 21:15:15 7042
2 : SUBROUTINE AMOR
3 : C
4 : C***********************************************************************
5 : C *
6 : C Premiere option : *
7 : C *
8 : C FABRICATION DE LA MATRICE D'AMORTISSEMENT MODAL *
9 : C SYNTAXE : AMO1= AMOR BASE PROG ; *
10 : C AMO1 MATRICE D'AMORTISSEMENT *
11 : C BASE OBJET DE TYPE BASE MODALE *
12 : C PROG OBJET DE TYPE MLREEL LISTE DES *
13 : C COEFFICIENTS D'AMORTISSEMENT REDUITS (%) *
14 : C CREATION : 26/11/86 *
15 : C PROGRAMMEUR : GUILBAUD *
16 : C *
17 : C______________________________________________________________________*
18 : C *
19 : C Deuxieme option : calcule la matrice d'amortissement visqueux *
20 : C associee a la frontiere d'un maillage *
21 : C *
22 : C Syntaxe : *
23 : C -------- *
24 : C *
25 : C RIG1 = AMOR MODL1 MAT1 GEO1 ; *
26 : C *
27 : C RIG1 : matrice d'amortissement construite (TYPE rigidite) *
28 : C MODL1: objet MMODEL, modele du sol ou du fluide a modeliser *
29 : C MAT1 : objet MCHAML, caracteristiques materiau *
30 : C GEO1 : objet MELEME, maillage de la frontiere *
31 : C *
32 : C date de creation : 26/02/98 *
33 : C "programmeur" : Olivier ROCHET *
34 : C *
35 : C______________________________________________________________________*
36 : C *
37 : C Troisieme option : calcule la matrice d'amortissement *
38 : C d'un materiau viscoelastique *
39 : C *
40 : C Syntaxe : *
41 : C -------- *
42 : C *
43 : C RIG1 (RIG2) = AMOR MODL1 MAT1 ('COROTATIF') ; *
44 : C *
45 : C RIG1 : matrice d'amortissement construite (TYPE rigidite) *
46 : C MODL1: objet MMODEL, modele du sol ou du fluide a modeliser *
47 : C MAT1 : objet MCHAML, caracteristiques materiau *
48 : C L'option COROTATIF permet de calculer la matrice de rigidite *
49 : C antisymetrique d'un arbre tournant (elements de poutre uniquement) *
50 : C *
51 : C date de creation : 07/07/03 *
52 : C "programmeur" : Didier COMBESCURE *
53 : C *
54 : C***********************************************************************
55 : C
56 : IMPLICIT INTEGER(I-N)
57 : IMPLICIT REAL*8 (A-H,O-Z)
58 :
59 : -INC CCOPTIO
60 : *
61 : PARAMETER (NPARAM = 1)
62 :
63 : LOGICAL BASMUL
64 : CHARACTER*8 CTYP
65 : CHARACTER*4 LPARAM(NPARAM)
66 : *
67 : DATA LPARAM / 'CORO' /
68 : *
69 : iretou = 0
70 : *
70 : CALL LIROBJ('LISTREEL',IPRO,0,iretou)
71 : IF (IERR.NE.0) RETURN
72 : *
73 : * -----
74 : * Cas 1 - Amortissement modal
75 : * -----
76 : IF (iretou.EQ.1) THEN
77 : *
78 : ICAS = 1
79 : IPRIG = 0
80 : *
81 : IBASE = 0
82 : ITBAS = 0
83 : BASMUL = .FALSE.
84 : *
84 : CALL QUETYP(CTYP,1,iretou)
85 : IF (IERR.NE.0) RETURN
86 : IF (CTYP(1:8).EQ.'TABLE ') THEN
86 : CALL LIRTAB('BASE_MODALE',ITBAS,0,iretou)
87 : IF (IERR.NE.0) RETURN
88 : IF (iretou.EQ.0) THEN
88 : CALL LIRTAB('ENSEMBLE_DE_BASES',ITBAS,1,iretou)
89 : IF (IERR.NE.0) RETURN
90 : BASMUL = .TRUE.
91 : ENDIF
92 : ELSE
92 : CALL LIROBJ('BASEMODA',IBASE,1,iretou)
93 : IF (IERR.NE.0) RETURN
94 : ENDIF
95 : *
95 : CALL AMORMO(IPRO,IBASE,ITBAS,BASMUL, IPRIG)
96 : IF (IERR.NE.0 .OR. IPRIG.LE.0) RETURN
97 : *
97 : CALL ECROBJ('RIGIDITE',IPRIG)
98 : *
99 : * ----------
100 : * Cas 2 et 3 - Frontieres absorbantes et amortissement visqueux
101 : * ----------
102 : ELSE
103 : *
104 : IPMODL = 0
105 : IPCHE1 = 0
106 : IPMAIL = 0
107 : IPRIG = 0
108 : IPRIG2 = 0
109 : C
110 : C lecture du modele
111 : C
111 : CALL LIROBJ('MMODEL',IPMODL,1,iretou)
112 : IF (IERR.NE.0) RETURN
113 : C
114 : C lecture du mchaml de caracteristiques materiau
115 : C
115 : CALL LIROBJ('MCHAML',IPCHE1,1,iretou)
116 : IF (IERR.NE.0) RETURN
117 : C
118 : C lecture du maillage de la frontiere
119 : C
119 : CALL LIROBJ('MAILLAGE',IPMAIL,0,iretou)
120 : IF (IERR.NE.0) RETURN
121 : *
122 : IF (iretou.NE.0) THEN
123 : ICAS = 2
124 : ELSE
125 : ICAS = 3
125 : CALL LIRMOT(LPARAM,NPARAM,iretou,0)
126 : IF (IERR.NE.0) RETURN
127 : IF (iretou.EQ.1) ICAS = 4
128 : ENDIF
129 : C
130 : IF (ICAS.EQ.2) THEN
131 : C
131 : CALL FRVISQ(IPMODL,IPMAIL,IPCHE1, IPRIG)
132 : IF (IERR.NE.0 .OR. IPRIG.LE.0) RETURN
133 : C
134 : ELSE IF (ICAS.EQ.3) THEN
135 : C
135 : CALL AMOR1(IPMODL,IPCHE1,1, IPRIG)
136 : IF (IERR.NE.0 .OR. IPRIG.LE.0) RETURN
137 : C
138 : ELSE IF (ICAS.EQ.4) THEN
139 : C
139 : CALL AMOR1(IPMODL,IPCHE1,2, IPRIG)
140 : IF (IERR.NE.0 .OR. IPRIG.LE.0) RETURN
141 : C
141 : CALL AMOR1(IPMODL,IPCHE1,1, IPRIG2)
142 : IF (IERR.NE.0 .OR. IPRIG2.LE.0) RETURN
143 : ENDIF
144 : C
144 : CALL ECROBJ('RIGIDITE',IPRIG)
144 : IF (ICAS.EQ.4) CALL ECROBJ('RIGIDITE',IPRIG2)
145 : C
146 : ENDIF
147 : C
148 : RETURN
149 : END
150 :
151 :
© Cast3M 2003 - All rights reserved.
Disclaimer