1 : C NORMOD SOURCE PV 09/03/12 21:29:37 6325
2 : SUBROUTINE NORMOD(ITBAS,LCHAIN)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8(A-H,O-Z)
5 :
6 : *--------------------------------------------------------------------*
7 : * *
8 : * Normalise le mode *
9 : * *
10 : * Param}tres: *
11 : * *
12 : * e ITBAS table de sous-type BASE_DE_MODES contenant les modes *
13 : * de la structure *
14 : * *
15 : * Auteur, date de cr{ation: *
16 : * *
17 : * Lionel VIVAN, le 15 juin 1990. *
18 : * *
19 : *--------------------------------------------------------------------*
20 : * *
21 : -INC CCOPTIO
22 : -INC SMCHPOI
23 : -INC SMCHAML
24 : -INC SMTABLE
25 : *
26 : INTEGER LCHAIN(*)
27 : CHARACTER*4 COMP
28 : *
29 : MTABLE = ITBAS
30 : SEGACT MTABLE
31 : LONG = MLOTAB
32 : IM = 1
33 : DO 10 I = 1,LONG
34 : IF (MTABTI(I).EQ.'ENTIER ' .AND. MTABII(I).EQ.IM .AND.
35 : & MTABTV(I).EQ.'TABLE ') THEN
36 : ITMOD = MTABIV(I)
37 : IM = IM + 1
38 : MTAB1 = ITMOD
39 : SEGACT MTAB1
40 : LON1 = MTAB1.MLOTAB
41 : XGRA = 0.D0
42 : DO 20 I1 = 1,LON1
43 : IF (MTAB1.MTABTI(I1).EQ.'MOT ' .AND.
44 : & MTAB1.MTABII(I1).EQ.LCHAIN(3) .AND.
45 : & MTAB1.MTABTV(I1).EQ.'CHPOINT ') THEN
46 : ICHDEP = MTAB1.MTABIV(I1)
47 : MCHPOI = ICHDEP
48 : SEGACT MCHPOI
49 : NSOU = IPCHP(/1)
50 : DO 22 INS = 1,NSOU
51 : MSOUPO = IPCHP(INS)
52 : SEGACT MSOUPO
53 : MPOVAL = IPOVAL
54 : SEGACT MPOVAL
55 : NBP = VPOCHA(/1)
56 : NBC = VPOCHA(/2)
57 : DO 24 IC = 1,NBC
58 : COMP = NOCOMP(IC)
59 : IF (COMP(1:1).EQ.'U' .OR. COMP(1:1).EQ.'R') THEN
60 : DO 26 IP = 1,NBP
61 : XVAL = VPOCHA(IP,IC)
62 : XAVA = ABS(XVAL)
63 : IF (XAVA.GT.XGRA) XGRA = XAVA
64 : 26 CONTINUE
65 : * end do
66 : ENDIF
67 : 24 CONTINUE
68 : * end do
69 : SEGDES MPOVAL
70 : SEGDES MSOUPO
71 : 22 CONTINUE
72 : * end do
73 : DO 32 INS = 1,NSOU
74 : MSOUPO = IPCHP(INS)
75 : SEGACT MSOUPO
76 : MPOVAL = IPOVAL
77 : SEGACT MPOVAL
78 : NBP = VPOCHA(/1)
79 : NBC = VPOCHA(/2)
80 : DO 34 IC = 1,NBC
81 : COMP = NOCOMP(IC)
82 : IF (COMP(1:1).EQ.'U' .OR. COMP(1:1).EQ.'R') THEN
83 : DO 36 IP = 1,NBP
84 : XDEP = VPOCHA(IP,IC)
85 : VPOCHA(IP,IC) = XDEP / XGRA
86 : 36 CONTINUE
87 : * end do
88 : ENDIF
89 : 34 CONTINUE
90 : * end do
91 : SEGDES MPOVAL
92 : SEGDES MSOUPO
93 : 32 CONTINUE
94 : * end do
95 : SEGDES MCHPOI
96 : MTAB1.MTABIV(I1) = ICHDEP
97 : ENDIF
98 : 20 CONTINUE
99 : * end do
100 : DO 40 I1 = 1,LON1
101 : IF (MTAB1.MTABTI(I1).EQ.'MOT ') THEN
102 : IF (MTAB1.MTABII(I1).EQ.LCHAIN(2) .AND.
103 : & MTAB1.MTABTV(I1).EQ.'TABLE ') THEN
104 : ITDEP = MTAB1.MTABIV(I1)
105 : MTAB2 = ITDEP
106 : SEGACT MTAB2
107 : LON2 = MTAB2.MLOTAB
108 : IDP = 1
109 : DO 42 I2 = 1,LON2
110 : IF (MTAB2.MTABTI(I2).EQ.'ENTIER ' .AND.
111 : & MTAB2.MTABII(I2).EQ.IDP .AND.
112 : & MTAB2.MTABTV(I2).EQ.'FLOTTANT') THEN
113 : IDP = IDP + 1
114 : XDEPG = MTAB2.RMTABV(I2)
115 : MTAB2.RMTABV(I2) = XDEPG / XGRA
116 : ENDIF
117 : 42 CONTINUE
118 : * end do
119 : SEGDES MTAB2
120 : MTAB1.MTABIV(I1) = ITDEP
121 : ELSE IF (MTAB1.MTABII(I1).EQ.LCHAIN(19) .AND.
122 : & MTAB1.MTABTV(I1).EQ.'FLOTTANT') THEN
123 : XMGEN = MTAB1.RMTABV(I1)
124 : MTAB1.RMTABV(I1) = XMGEN / (XGRA * XGRA)
125 : ELSE IF (MTAB1.MTABII(I1).EQ.LCHAIN(5) .AND.
126 : & MTAB1.MTABTV(I1).EQ.'CHPOINT ') THEN
127 : ICHREA = MTAB1.MTABIV(I1)
128 : MCHPOI = ICHREA
129 : SEGACT MCHPOI
130 : NSOU = IPCHP(/1)
131 : DO 50 INS = 1,NSOU
132 : MSOUPO = IPCHP(INS)
133 : SEGACT MSOUPO
134 : MPOVAL = IPOVAL
135 : SEGACT MPOVAL
136 : NBP = VPOCHA(/1)
137 : NBC = VPOCHA(/2)
138 : DO 52 IC = 1,NBC
139 : DO 54 IP = 1,NBP
140 : XREA = VPOCHA(IP,IC)
141 : VPOCHA(IP,IC) = XREA / XGRA
142 : 54 CONTINUE
143 : * end do
144 : 52 CONTINUE
145 : * end do
146 : SEGDES MPOVAL
147 : SEGDES MSOUPO
148 : 50 CONTINUE
149 : * end do
150 : SEGDES MCHPOI
151 : MTAB1.MTABIV(I1) = ICHREA
152 : ELSE IF (MTAB1.MTABII(I1).EQ.LCHAIN(4) .AND.
153 : & MTAB1.MTABTV(I1).EQ.'MCHAML ') THEN
154 : ICHCON = MTAB1.MTABIV(I1)
155 : MCHELM = ICHCON
156 : SEGACT MCHELM
157 : N1 = IMACHE(/1)
158 : DO 60 IN = 1,N1
159 : MCHAML = ICHAML(IN)
160 : SEGACT MCHAML
161 : NCO = NOMCHE(/1)
162 : DO 62 ICO = 1,NCO
163 : MELVAL = IELVAL(ICO)
164 : SEGACT MELVAL
165 : N1P = VELCHE(/1)
166 : N1E = VELCHE(/2)
167 : DO 64 IP = 1,N1P
168 : DO 66 IE = 1,N1E
169 : XCON = VELCHE(IP,IE)
170 : VELCHE(IP,IE) = XCON/XGRA
171 : 66 CONTINUE
172 : 64 CONTINUE
173 : SEGDES MELVAL
174 : 62 CONTINUE
175 : SEGDES MCHAML
176 : 60 CONTINUE
177 : SEGDES MCHELM
178 : MTAB1.MTABIV(I1) = ICHCON
179 : ENDIF
180 : ENDIF
181 : 40 CONTINUE
182 : * end do
183 : SEGDES MTAB1
184 : ENDIF
185 : 10 CONTINUE
186 : * end do
187 : SEGDES MTABLE
188 : *
189 : END
190 :
191 :
192 :
© Cast3M 2003 - All rights reserved.
Disclaimer