Télécharger la plaquette Cast3M


fr en

Télécharger ajuste.eso

Retour à la liste

Numérotation des lignes : 

ajuste

  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