1 : C PSCHPT SOURCE AM 08/02/14 21:28:02 6050
2 : SUBROUTINE PSCHPT(IRAID,IMASS,MTRAV,ICHPT,TYP,ICHP1)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8(A-H,O-Z)
5 : ************************************************************************
6 : *
7 : * P S C H P T
8 : * -----------
9 : *
10 : * FONCTION:
11 : * ---------
12 : *
13 : * calcule le pseudo-mode en d{placement pour un CHPOINT.
14 : *
15 : * MODULES UTILISES:
16 : * -----------------
17 : *
18 : -INC CCHAMP
19 : -INC CCOPTIO
20 : -INC SMCHPOI
21 : *
22 : * PARAMETRES: (e)=entr{e (s)=sortie
23 : * -----------
24 : *
25 : * IRAID (e) pointeur sur la matrice K de la structure.
26 : * IMASS (e) pointeur sur la matrice M de la structure.
27 : * MTRAV (e) pointeur sur un segment contenant les modes.
28 : * ICHPT (e) pointeur sur le chpoint force.
29 : * TYP (e) = 'FORC', chpoint de type force.
30 : * = 'DEPL', chpoint de type d{placement.
31 : * ICHP1 (s) pointeur sur le pseudo-mode en d{placement.
32 : *
33 : *
34 : SEGMENT MTRAV
35 : REAL*8 FREQ(NBMODE),MN(NBMODE),MW2(NBMODE),
36 : & QX(NBMODE),QY(NBMODE),QZ(NBMODE)
37 : INTEGER DEPL(NBMODE)
38 : ENDSEGMENT
39 : *
40 : *
41 : * VARIABLES:
42 : * ----------
43 : *
44 : CHARACTER*4 TYP,NOM,LNOM
45 : *
46 : *
47 : * AUTEUR, DATE DE CREATION:
48 : * -------------------------
49 : *
50 : * Lionel VIVAN Avril 1990
51 : *
52 : ************************************************************************
53 : *
54 : ICHP1 = 0
55 : *
56 : IF (TYP.EQ.'FORC') THEN
57 : I5 = 1
57 : CALL COPIE2(ICHPT,ICHP2)
58 : MCHPOI = ICHP2
59 : SEGACT MCHPOI
60 : NSOU = IPCHP(/1)
61 : DO 10 I = 1,NSOU
62 : MSOUPO = IPCHP(I)
63 : SEGACT MSOUPO
64 : NC = NOCOMP(/2)
65 : *
66 : * liste des composantes
67 : *
68 : DO 20 I4 = 1,NC
69 : NOM = NOCOMP(I4)
69 : CALL PLACE(NOMDU,40,INOM,NOM)
70 : LNOM = NOMDD(INOM)
71 : IF (I4.EQ.1 .AND. I.EQ.1) THEN
71 : CALL ECRCHA(NOM)
71 : CALL MOTS
72 : IF (IERR.NE.0) RETURN
72 : CALL LIROBJ('LISTMOTS',IMOT1,1,IRETOU)
73 : IF (IERR.NE.0) RETURN
73 : CALL ECRCHA(LNOM)
73 : CALL MOTS
74 : IF (IERR.NE.0) RETURN
74 : CALL LIROBJ('LISTMOTS',IMOT2,1,IRETOU)
75 : IF (IERR.NE.0) RETURN
76 : ELSE
77 : I5 = I5 + 1
77 : CALL INSER3(IMOT1,I5,NOM)
78 : IF (IERR.NE.0) RETURN
78 : CALL INSER3(IMOT2,I5,LNOM)
79 : IF (IERR.NE.0) RETURN
80 : ENDIF
81 : 20 CONTINUE
82 : * end do
83 : SEGDES MSOUPO
84 : 10 CONTINUE
85 : * end do
86 : SEGDES MCHPOI
87 : ENDIF
88 : *
89 : SEGACT MTRAV
90 : NBMODE = FREQ(/1)
91 : *
92 : * r{solution du syst}me statique
93 : *
94 : IF (TYP.EQ.'DEPL') THEN
94 : CALL MUCHPO(ICHPT,-1.D0,ICHP3,1)
95 : IF (IERR.NE.0) RETURN
95 : CALL MUCPRI(ICHP3,IMASS,ICHP2)
96 : IF (IERR.NE.0) RETURN
96 : CALL DECHPO(ICHP3)
97 : IF (IERR.NE.0) RETURN
98 : ENDIF
98 : CALL ECROBJ('CHPOINT ',ICHP2)
98 : CALL ECROBJ('RIGIDITE',IRAID)
98 : CALL RESOU
99 : IF (IERR.NE.0) RETURN
99 : CALL LIROBJ('CHPOINT ',ICHPST,1,IRETOU)
100 : IF (IERR.NE.0) RETURN
101 : *
102 : * r{solution du syst}me dynamique
103 : *
104 : DO 30 ID = 1,NBMODE
105 : IPHI = DEPL(ID)
106 : IF (TYP.EQ.'FORC') THEN
106 : CALL XTY1(IPHI,ICHP2,IMOT2,IMOT1,XPHINF)
107 : IF (IERR.NE.0) RETURN
108 : XFLOT = XPHINF / MW2(ID)
109 : ELSE IF (TYP.EQ.'DEPL') THEN
109 : CALL YTMX(IPHI,ICHPT,IMASS,RNI)
110 : IF (IERR.NE.0) RETURN
111 : XFLOT = -1.D0 * RNI / MW2(ID)
112 : ENDIF
113 : IF (ID .EQ. 1) THEN
113 : CALL MUCHPO(IPHI,XFLOT,ICHPDY,1)
114 : IF (IERR.NE.0) RETURN
115 : ELSE
115 : CALL ADCHPO(ICHPDY,IPHI,ICHP4,1D0,XFLOT)
116 : IF (IERR.NE.0) RETURN
116 : CALL DECHPO(ICHPDY)
117 : IF (IERR.NE.0) RETURN
118 : ICHPDY = ICHP4
119 : ENDIF
120 : 30 CONTINUE
121 : * end do
122 : *
123 : * calcul du pseudo-mode
124 : *
124 : CALL ADCHPO(ICHPST,ICHPDY,ICHP1,1D0,-1D0)
125 : IF (IERR.NE.0) RETURN
125 : CALL DECHPO(ICHPST)
126 : IF (IERR.NE.0) RETURN
126 : CALL DECHPO(ICHPDY)
127 : IF (IERR.NE.0) RETURN
127 : CALL DECHPO(ICHP2)
128 : IF (IERR.NE.0) RETURN
129 : *
130 : SEGDES MTRAV
131 : *
132 : END
133 :
134 :
135 :
© Cast3M 2003 - All rights reserved.
Disclaimer