1 : C PSCHOC SOURCE CHAT 05/01/13 02:37:16 5004
2 : SUBROUTINE PSCHOC(IRAID,MTRAV,IPCH,NORM,IJ, ICHP1)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8(A-H,O-Z)
5 : ************************************************************************
6 : *
7 : * P S C H O C
8 : * -----------
9 : *
10 : * FONCTION:
11 : * ---------
12 : *
13 : * calcule le pseudo-mode en d{placement pour une force de choc.
14 : *
15 : * MODULES UTILISES:
16 : * -----------------
17 : *
18 : -INC CCOPTIO
19 : -INC CCREEL
20 : -INC SMCOORD
21 : *
22 : * PARAMETRES: (e)=entr{e (s)=sortie
23 : * -----------
24 : *
25 : * IRAID (e) pointeur sur la matrice K de la structure.
26 : * MTRAV (e) pointeur sur un segemnt contenant les modes.
27 : * IPCH (e) point de choc.
28 : * NORM (e) normale de choc.
29 : * IJ (e) point de la structure IJ
30 : * ICHP1 (s) pointeur sur le pseudo-mode en d{placement.
31 : *
32 : *
33 : SEGMENT MTRAV
34 : REAL*8 FREQ(NBMODE),MN(NBMODE),MW2(NBMODE),
35 : & QX(NBMODE),QY(NBMODE),QZ(NBMODE)
36 : INTEGER DEPL(NBMODE)
37 : ENDSEGMENT
38 : *
39 : *
40 : * AUTEUR, DATE DE CREATION:
41 : * -------------------------
42 : *
43 : * Lionel VIVAN Juillet 1988
44 : *
45 : ************************************************************************
46 : *
47 : ICHP1 = 0
48 : *
49 : * normalisation de la normale
50 : *
51 : IPNV = (IDIM + 1) * (NORM - 1)
52 : PS = 0.D0
53 : DO 10 ID = 1,IDIM
54 : XC = XCOOR(IPNV + ID)
55 : PS = PS + XC * XC
56 : 10 CONTINUE
57 : IF (PS.LT.XPETIT) THEN
57 : CALL ERREUR(162)
58 : RETURN
59 : ENDIF
60 : RACPS = SQRT(PS)
61 : XX = XCOOR(IPNV + 1) / RACPS
62 : XY = XCOOR(IPNV + 2) / RACPS
63 : IF (IDIM.EQ.3) THEN
64 : XZ = XCOOR(IPNV + 3) / RACPS
65 : ENDIF
66 : IF (IJ.EQ.2) THEN
67 : XX = -1.D0 * XX
68 : XY = -1.D0 * XY
69 : IF (IDIM.EQ.3) THEN
70 : XZ = -1.D0 * XZ
71 : ENDIF
72 : ENDIF
73 : *
74 : * liste des composantes
75 : *
76 : IF (IDIM.EQ.3) THEN
76 : CALL ECRCHA('UZ')
77 : ENDIF
77 : CALL ECRCHA('UY')
77 : CALL ECRCHA('UX')
77 : CALL MOTS
77 : CALL LIROBJ('LISTMOTS',IMOT1,1,IRETOU)
78 : IF (IERR.NE.0) RETURN
79 : IF (IDIM.EQ.3) THEN
79 : CALL ECRCHA('FZ')
80 : ENDIF
80 : CALL ECRCHA('FY')
80 : CALL ECRCHA('FX')
80 : CALL MOTS
80 : CALL LIROBJ('LISTMOTS',IMOT2,1,IRETOU)
81 : IF (IERR.NE.0) RETURN
82 : *
83 : * cr{ation du chpoint force
84 : *
85 : IF (IDIM.EQ.3) THEN
85 : CALL ECRREE(XZ)
85 : CALL ECRCHA('FZ')
86 : ENDIF
86 : CALL ECRREE(XY)
86 : CALL ECRCHA('FY')
86 : CALL ECRREE(XX)
86 : CALL ECRCHA('FX')
86 : CALL ECRENT(IDIM)
86 : CALL ECROBJ('POINT',IPCH)
86 : CALL ECRCHA('CHPO')
86 : CALL MANUEL
86 : CALL LIROBJ('CHPOINT ',ICHP2,1,IRETOU)
87 : IF (IERR.NE.0) RETURN
88 : *
89 : SEGACT MTRAV
90 : NBMODE = FREQ(/1)
91 : *
92 : * r{solution du syst}me statique
93 : *
93 : CALL ECROBJ('CHPOINT ',ICHP2)
93 : CALL ECROBJ('RIGIDITE',IRAID)
93 : CALL RESOU
93 : CALL LIROBJ('CHPOINT ',ICHPST,1,IRETOU)
94 : IF (IERR.NE.0) RETURN
95 : *
96 : * r{solution du syst}me dynamique
97 : *
98 : DO 70 ID = 1,NBMODE
99 : IPHI = DEPL(ID)
99 : CALL XTY1(IPHI,ICHP2,IMOT1,IMOT2,XPHINF)
100 : IF (IERR.NE.0) RETURN
101 : XFLOT = XPHINF / MW2(ID)
102 : IF (ID .EQ. 1) THEN
102 : CALL MUCHPO(IPHI,XFLOT,ICHPDY,1)
103 : IF (IERR.NE.0) RETURN
104 : ELSE
104 : CALL ADCHPO(ICHPDY,IPHI,ICHP4,1D0,XFLOT)
105 : IF (IERR.NE.0) RETURN
105 : CALL DECHPO(ICHPDY)
106 : IF (IERR.NE.0) RETURN
107 : ICHPDY = ICHP4
108 : ENDIF
109 : 70 CONTINUE
110 : *
111 : * calcul du pseudo-mode
112 : *
112 : CALL ADCHPO(ICHPST,ICHPDY,ICHP1,1D0,-1D0)
113 : IF (IERR.NE.0) RETURN
113 : CALL DECHPO(ICHPST)
114 : IF (IERR.NE.0) RETURN
114 : CALL DECHPO(ICHPDY)
115 : IF (IERR.NE.0) RETURN
116 : *
117 : SEGDES MTRAV
118 : *
119 : END
120 :
121 :
122 :
© Cast3M 2003 - All rights reserved.
Disclaimer