Numérotation des lignes :

1. C OTTOB3 SOURCE CHAT 05/01/13 02:07:00 5004
3. C======================================================================
4. C
5. C ENTREES
6. C -------
7. C A(3,3) = MATRICE SYMETRIQUE
8. C B(3,3) = MATRICE SYMETRIQUE
9. C LADIM = 2 OU 3 SI 2 ON NE S OCCUPE QUE DE A(2,2)
10. C SI 3 DE A(3,3)
11. C SORTIES
12. C -------
13. C
14. C ON SORT XX(1) &lt; XX(2) &lt; XX(3)
15. C
16. C===============================================================
17. IMPLICIT INTEGER(I-N)
18. IMPLICIT REAL*8 (A-H,O-Z)
19. -INC CCOPTIO
20. DIMENSION A(3,3),B(3,3),XX(3)
21. *
22. KERRE=0
23. *
25. *
26. * CAS DIMENSION 2
27. *
28. * A0 + A1*X + A2* X2
29. *
30. A0=A(1,1)*A(2,2)-A(1,2)*A(1,2)
31. A1=A(1,1)*B(2,2)+A(2,2)*B(1,1)-2.D0*A(1,2)*B(1,2)
32. A2=B(1,1)*B(2,2)-B(1,2)*B(1,2)
33.
34. *
35. IF(IIMPI.EQ.42) THEN
36. WRITE(IOIMP,70615) A0,A1,A2
37. 70615 FORMAT(2X,'OTTOB3 - A0 A1 A2 ',3(1X,1PE12.5)/)
38. ENDIF
39. *
40. IF(A2.EQ.0.D0) THEN
41. IF(A1.EQ.0.D0) THEN
42. WRITE(IOIMP,76000)
43. 76000 FORMAT(2X,'OTTOB3 - A2 ET A1 SONT NULS ' )
44. KERRE=70
45. RETURN
46. ENDIF
47. XX1=-A0/A1
48. XX2=1.D4
49. ELSE IF(A1.EQ.0.D0) THEN
50. DIS=-A0/A2
51. IF(DIS.LT.0.D0) THEN
52. WRITE(IOIMP,76001) DIS
53. 76001 FORMAT(2X,'OTTOB3 - RAPPORT DIS NEGATIF = ',1PE12.5/)
54. KERRE=70
55. RETURN
56. ENDIF
57. XX1=-SQRT(DIS)
58. XX2= SQRT(DIS)
59. ELSE
60. AUX=4.D0*A2*A0/(A1*A1)
61. IF(ABS(AUX).LT.1.D-8) THEN
62. XX1=-A0/A1 - A0*A0*A2/(A1**3)
63. XX2=-A1/A2 -XX1
64. ELSE
65. DIS = A1*A1-4.D0*A2*A0
66. *
67. IF(DIS.LT.0.D0) THEN
68. AUX=1.D-12*A1*A1
69. IF(ABS(DIS).LT.AUX ) THEN
70. DIS= MAX(DIS,0.D0)
71. ELSE
72. WRITE(IOIMP,76002) DIS , AUX
73. 76002 FORMAT(2X,'OTTOB3 - DISCRIMINANT NEGATIF = ',
74. & 1PE12.5,2X,' AUX=',1PE12.5/)
75. KERRE=70
76. RETURN
77. ENDIF
78. ENDIF
79. DIS=SQRT(DIS)
80. XX1=(-A1-DIS)/(2.D0*A2)
81. XX2=(-A1+DIS)/(2.D0*A2)
82. ENDIF
83. ENDIF
84. XX(1)=MIN(XX1,XX2)
85. XX(2)=MAX(XX1,XX2)
86. RETURN
87. *
88. * CAS DIMENSION 3
89. *
90. * A0 + A1*X + A2* X2 + A3* X3
91. *
92. 700 CONTINUE
93. *
94. A0=A(1,1)*(A(2,2)*A(3,3)-A(2,3)*A(2,3))
95. & -A(1,2)*(A(3,3)*A(1,2)-A(1,3)*A(2,3))
96. & +A(1,3)*(A(1,2)*A(2,3)-A(2,2)*A(1,3))
97. *
98. A1=A(1,1)*(A(3,3)*B(2,2)+A(2,2)*B(3,3)-2.D0*A(2,3)*B(2,3))
99. & -A(1,2)*(A(3,3)*B(1,2)+A(1,2)*B(3,3)
100. & -A(1,3)*B(2,3)-A(2,3)*B(1,3))
101. & +A(1,3)*(A(2,3)*B(1,2)+A(1,2)*B(2,3)
102. & -A(1,3)*B(2,2)-A(2,2)*B(1,3))
103. & +B(1,1)*(A(2,2)*A(3,3)-A(2,3)*A(2,3))
104. & -B(1,2)*(A(3,3)*A(1,2)-A(2,3)*A(1,3))
105. & +B(1,3)*(A(1,2)*A(2,3)-A(2,2)*A(1,3))
106. *
107. A2=B(1,1)*(A(3,3)*B(2,2)+A(2,2)*B(3,3)-2.D0*A(2,3)*B(2,3))
108. & -B(1,2)*(A(3,3)*B(1,2)+A(1,2)*B(3,3)
109. & -A(1,3)*B(2,3)-A(2,3)*B(1,3))
110. & +B(1,3)*(A(2,3)*B(1,2)+A(1,2)*B(2,3)
111. & -A(1,3)*B(2,2)-A(2,2)*B(1,3))
112. & +A(1,1)*(B(2,2)*B(3,3)-B(2,3)*B(2,3))
113. & -A(1,2)*(B(3,3)*B(1,2)-B(2,3)*B(1,3))
114. & +A(1,3)*(B(1,2)*B(2,3)-B(2,2)*B(1,3))
115. *
116. A3=B(1,1)*(B(2,2)*B(3,3)-B(2,3)*B(2,3))
117. & -B(1,2)*(B(3,3)*B(1,2)-B(1,3)*B(2,3))
118. & +B(1,3)*(B(1,2)*B(2,3)-B(2,2)*B(1,3))
119. *
120. IF(IIMPI.EQ.42) THEN
121. WRITE(IOIMP,70616) A0,A1,A2,A3
122. 70616 FORMAT(2X,'OTTOB3 - A0 A1 A2 A3 ',4(1X,1PE12.5)/)
123. ENDIF
124. ******
125. IF(ABS(A3).LT.1.D-6) THEN
126. A3=0.D0
127. ENDIF
128. ********
129.
130. *
131. IF(A3.EQ.0.D0) THEN
132. *
133. IF(A2.EQ.0.D0) THEN
134. IF(A1.EQ.0.D0) THEN
135. WRITE(IOIMP,76003)
136. 76003 FORMAT(2X,'OTTOB3 - A3, A2 ET A1 SONT NULS ' )
137. KERRE=70
138. RETURN
139. ENDIF
140. XX(1)=-A0/A1
141. XX(2)=1.D4
142. XX(3)=1.D4
143. ELSE
144. DIS = A1*A1-4.D0*A2*A0
145. ***********
146. DIS = MAX ( DIS, 0.D0)
147. ***********
148.
149.
150. IF(DIS.LT.0.D0) THEN
151. WRITE(IOIMP,76001) DIS
152. KERRE=70
153. RETURN
154. ENDIF
155. DIS=SQRT(DIS)
156. XX(1)=(-A1-DIS)/(2.D0*A2)
157. XX(2)=(-A1+DIS)/(2.D0*A2)
158. XX(3)=1.D4
159. ENDIF
160. RETURN
161. *
162. ELSE
163. *
164. * MISE SOUS FORME POUR DEGRE3
165. *
166. AS0=A0/A3
167. AS1=A1/A3
168. AS2=A2/A3
169. *
170. CALL DEGRE3(AS0,AS1,AS2,XR1,XI1,XR2,XI2,XR3,XI3)
171. *
172. IF(IIMPI.EQ.42) THEN
173. WRITE(IOIMP,76005) XR1,XI1,XR2,XI2,XR3,XI3
174. 76005 FORMAT(2X,'OTTOB3 - XR1 = ',1PE12.5,2X,'XI1=',1PE12.5/
175. & 2X,' XR2 = ',1PE12.5,2X,'XI2=',1PE12.5/
176. & 2X,' XR3 = ',1PE12.5,2X,'XI3=',1PE12.5/)
177. ENDIF
178. *
179. * xi1 est toujours nul
180. *
181. IF(XI2.NE.0.D0) THEN
182. XX(1)=XR1
183. XX(2)=1.D4
184. XX(3)=1.D4
185. ELSE
186. IF (XR1.LE.XR2.AND.XR1.LE.XR3)THEN
187. XX(1)=XR1
188. XX(2)=XR2
189. XX(3)=XR3
190. IF (XR3.LE.XR2) THEN
191. XX(2)=XR3
192. XX(3)=XR2
193. ENDIF
194. *
195. ELSE IF (XR2.LE.XR3.AND.XR2.LE.XR1)THEN
196. XX(1)=XR2
197. XX(2)=XR3
198. XX(3)=XR1
199. IF (XR1.LE.XR3) THEN
200. XX(2)=XR1
201. XX(3)=XR3
202. ENDIF
203. *
204. ELSE IF (XR3.LE.XR1.AND.XR3.LE.XR2)THEN
205. XX(1)=XR3
206. XX(2)=XR1
207. XX(3)=XR2
208. IF (XR2.LE.XR1) THEN
209. XX(2)=XR2
210. XX(3)=XR1
211. ENDIF
212. ENDIF
213. ENDIF
214. ENDIF
215. RETURN
216. END
217.
218.
219.
220.

© Cast3M 2003 - Tous droits réservés.
Mentions légales