Télécharger ajuste.eso

Retour à la liste

Numérotation des lignes :

  1. C AJUSTE SOURCE GOUNAND 12/08/01 21:15:01 7453
  2. SUBROUTINE AJUSTE(V1,V2,V3,XLTR,EPTR,XLTT,EPTT,EPRS,RT,OUVER,
  3. . W1,W2,W3,YLTR,DETR,YLTT,DETT,DERS,ST,FISSU,
  4. . ANGLE,NBVECD,KAS,MODE)
  5. C
  6. C--------------------------------------------------------------------
  7. C CORRESPONDANCE EN FONCTION DE KAS
  8. C--------------------------------------------------------------------
  9. C
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8(A-H,O-Z)
  12. C
  13. DIMENSION V1(*),V2(*),V3(*),XLTR(*),XLTT(*),EPTR(*),EPTT(*),
  14. . EPRS(*),OUVER(*),RT(*)
  15. DIMENSION W1(*),W2(*),W3(*),YLTR(*),YLTT(*),DETR(*),DETT(*),
  16. . DERS(*),FISSU(*),ST(*)
  17. C
  18. C MODE = 1 CORRESPONDANCE EN ENTREE
  19. C MODE = 2 CORRESPONDANCE EN SORTIE
  20. C
  21. GO TO (1,2),MODE
  22. C
  23. C====================================================================
  24. C MODE = 1
  25. C====================================================================
  26. C
  27. 1 CONTINUE
  28. C
  29. GO TO(11,12,13),KAS
  30. C
  31. C--------------------------------------------------------------------
  32. C KAS = 1
  33. C--------------------------------------------------------------------
  34. C
  35. 11 CONTINUE
  36. C
  37. YLTR(1)=XLTR(2)
  38. YLTR(2)=XLTR(3)
  39. YLTR(3)=XLTR(1)
  40. C
  41. YLTT(1)=XLTT(2)
  42. YLTT(2)=XLTT(3)
  43. YLTT(3)=XLTT(1)
  44. C
  45. DETR(1)=EPTR(2)
  46. DETR(2)=EPTR(3)
  47. DETR(3)=EPTR(1)
  48. C
  49. DETT(1)=EPTT(2)
  50. DETT(2)=EPTT(3)
  51. DETT(3)=EPTT(1)
  52. C
  53. DERS(1)=EPRS(2)
  54. DERS(2)=EPRS(3)
  55. DERS(3)=EPRS(1)
  56. C
  57. FISSU(1)=OUVER(2)
  58. FISSU(2)=OUVER(3)
  59. FISSU(3)=OUVER(1)
  60. C
  61. ST(1)=RT(2)
  62. ST(2)=RT(3)
  63. ST(3)=RT(1)
  64. C
  65. DO 111 I=1,3
  66. W1(I)=V2(I)
  67. W2(I)=V3(I)
  68. W3(I)=V1(I)
  69. 111 CONTINUE
  70. C
  71. IF(NBVECD.EQ.0) RETURN
  72. IF(NBVECD.EQ.1) IANGLE=0
  73. IF(NBVECD.EQ.2) IANGLE=2
  74. CALL CLREP(W1,W2,W3,ANGLE,IANGLE)
  75. C
  76. RETURN
  77. C
  78. C--------------------------------------------------------------------
  79. C KAS = 2
  80. C--------------------------------------------------------------------
  81. C
  82. 12 CONTINUE
  83. C
  84. YLTR(1)=XLTR(3)
  85. YLTR(2)=XLTR(1)
  86. YLTR(3)=XLTR(2)
  87. C
  88. YLTT(1)=XLTT(3)
  89. YLTT(2)=XLTT(1)
  90. YLTT(3)=XLTT(2)
  91. C
  92. DETR(1)=EPTR(3)
  93. DETR(2)=EPTR(1)
  94. DETR(3)=EPTR(2)
  95. C
  96. DETT(1)=EPTT(3)
  97. DETT(2)=EPTT(1)
  98. DETT(3)=EPTT(2)
  99. C
  100. DERS(1)=EPRS(3)
  101. DERS(2)=EPRS(1)
  102. DERS(3)=EPRS(2)
  103. C
  104. FISSU(1)=OUVER(3)
  105. FISSU(2)=OUVER(1)
  106. FISSU(3)=OUVER(2)
  107. C
  108. ST(1)=RT(3)
  109. ST(2)=RT(1)
  110. ST(3)=RT(2)
  111. C
  112. DO 121 I=1,3
  113. W1(I)=V3(I)
  114. W2(I)=V1(I)
  115. W3(I)=V2(I)
  116. 121 CONTINUE
  117. C
  118. IF(NBVECD.EQ.0) RETURN
  119. IF(NBVECD.EQ.1) IANGLE=0
  120. IF(NBVECD.EQ.2) IANGLE=2
  121. CALL CLREP(W1,W2,W3,ANGLE,IANGLE)
  122. C
  123. RETURN
  124. C
  125. C--------------------------------------------------------------------
  126. C KAS = 3
  127. C--------------------------------------------------------------------
  128. C
  129. 13 CONTINUE
  130. C
  131. DO 131 I=1,3
  132. YLTR(I)=XLTR(I)
  133. YLTT(I)=XLTT(I)
  134. DETR(I)=EPTR(I)
  135. DETT(I)=EPTT(I)
  136. DERS(I)=EPRS(I)
  137. FISSU(I)=OUVER(I)
  138. ST(I)=RT(I)
  139. W1(I)=V1(I)
  140. W2(I)=V2(I)
  141. W3(I)=V3(I)
  142. 131 CONTINUE
  143. C
  144. IF(NBVECD.EQ.0) RETURN
  145. IF(NBVECD.EQ.1) IANGLE=0
  146. IF(NBVECD.EQ.2) IANGLE=2
  147. CALL CLREP(W1,W2,W3,ANGLE,IANGLE)
  148. C
  149. RETURN
  150. C
  151. C====================================================================
  152. C MODE = 2
  153. C====================================================================
  154. C
  155. 2 CONTINUE
  156. C
  157. GO TO(21,22,23),KAS
  158. C
  159. C--------------------------------------------------------------------
  160. C KAS = 1
  161. C--------------------------------------------------------------------
  162. C
  163. 21 CONTINUE
  164. C
  165. XLTR(2)=YLTR(1)
  166. XLTR(3)=YLTR(2)
  167. XLTR(1)=YLTR(3)
  168. C
  169. XLTT(2)=YLTT(1)
  170. XLTT(3)=YLTT(2)
  171. XLTT(1)=YLTT(3)
  172. C
  173. EPTR(2)=DETR(1)
  174. EPTR(3)=DETR(2)
  175. EPTR(1)=DETR(3)
  176. C
  177. EPTT(2)=DETT(1)
  178. EPTT(3)=DETT(2)
  179. EPTT(1)=DETT(3)
  180. C
  181. EPRS(2)=DERS(1)
  182. EPRS(3)=DERS(2)
  183. EPRS(1)=DERS(3)
  184. C
  185. OUVER(2)=FISSU(1)
  186. OUVER(3)=FISSU(2)
  187. OUVER(1)=FISSU(3)
  188. C
  189. RT(2)=ST(1)
  190. RT(3)=ST(2)
  191. RT(1)=ST(3)
  192. C
  193. IF(NBVECD.EQ.0) THEN
  194. DO 211 I=1,3
  195. W1(I)=0.D0
  196. W2(I)=0.D0
  197. W3(I)=0.D0
  198. 211 CONTINUE
  199. ENDIF
  200. C
  201. IF(NBVECD.EQ.1) THEN
  202. DO 212 I=1,3
  203. W1(I)=0.D0
  204. W2(I)=0.D0
  205. 212 CONTINUE
  206. ENDIF
  207. C
  208. IF(NBVECD.EQ.2) THEN
  209. IANGLE=3
  210. CALL CLREP(W1,W2,W3,ANGLE,IANGLE)
  211. ENDIF
  212. C
  213. DO 213 I=1,3
  214. V2(I)=W1(I)
  215. V3(I)=W2(I)
  216. V1(I)=W3(I)
  217. 213 CONTINUE
  218. C
  219. RETURN
  220. C
  221. C--------------------------------------------------------------------
  222. C KAS = 2
  223. C--------------------------------------------------------------------
  224. C
  225. 22 CONTINUE
  226. C
  227. XLTR(3)=YLTR(1)
  228. XLTR(1)=YLTR(2)
  229. XLTR(2)=YLTR(3)
  230. C
  231. XLTT(3)=YLTT(1)
  232. XLTT(1)=YLTT(2)
  233. XLTT(2)=YLTT(3)
  234. C
  235. EPTR(3)=DETR(1)
  236. EPTR(1)=DETR(2)
  237. EPTR(2)=DETR(3)
  238. C
  239. EPTT(3)=DETT(1)
  240. EPTT(1)=DETT(2)
  241. EPTT(2)=DETT(3)
  242. C
  243. EPRS(3)=DERS(1)
  244. EPRS(1)=DERS(2)
  245. EPRS(2)=DERS(3)
  246. C
  247. OUVER(3)=FISSU(1)
  248. OUVER(1)=FISSU(2)
  249. OUVER(2)=FISSU(3)
  250. C
  251. RT(3)=ST(1)
  252. RT(1)=ST(2)
  253. RT(2)=ST(3)
  254. C
  255. IF(NBVECD.EQ.0) THEN
  256. DO 221 I=1,3
  257. W1(I)=0.D0
  258. W2(I)=0.D0
  259. W3(I)=0.D0
  260. 221 CONTINUE
  261. ENDIF
  262. C
  263. IF(NBVECD.EQ.1) THEN
  264. DO 222 I=1,3
  265. W1(I)=0.D0
  266. W2(I)=0.D0
  267. 222 CONTINUE
  268. ENDIF
  269. C
  270. IF(NBVECD.EQ.2) THEN
  271. IANGLE=3
  272. CALL CLREP(W1,W2,W3,ANGLE,IANGLE)
  273. ENDIF
  274. C
  275. DO 223 I=1,3
  276. V3(I)=W1(I)
  277. V1(I)=W2(I)
  278. V2(I)=W3(I)
  279. 223 CONTINUE
  280. C
  281. RETURN
  282. C
  283. C--------------------------------------------------------------------
  284. C KAS = 3
  285. C--------------------------------------------------------------------
  286. C
  287. 23 CONTINUE
  288. C
  289. DO 231 I=1,3
  290. XLTR(I)=YLTR(I)
  291. XLTT(I)=YLTT(I)
  292. EPTR(I)=DETR(I)
  293. EPTT(I)=DETT(I)
  294. EPRS(I)=DERS(I)
  295. OUVER(I)=FISSU(I)
  296. RT(I)=ST(I)
  297. 231 CONTINUE
  298. C
  299. IF(NBVECD.EQ.0) THEN
  300. DO 232 I=1,3
  301. W1(I)=0.D0
  302. W2(I)=0.D0
  303. W3(I)=0.D0
  304. 232 CONTINUE
  305. ENDIF
  306. C
  307. IF(NBVECD.EQ.1) THEN
  308. DO 233 I=1,3
  309. W1(I)=0.D0
  310. W2(I)=0.D0
  311. 233 CONTINUE
  312. ENDIF
  313. C
  314. IF(NBVECD.EQ.2) THEN
  315. IANGLE=3
  316. CALL CLREP(W1,W2,W3,ANGLE,IANGLE)
  317. ENDIF
  318. C
  319. DO 234 I=1,3
  320. V1(I)=W1(I)
  321. V2(I)=W2(I)
  322. V3(I)=W3(I)
  323. 234 CONTINUE
  324. C
  325. RETURN
  326. C
  327. END
  328.  
  329.  
  330.  

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