Télécharger la plaquette Cast3M


fr en

Télécharger devlb2.eso

Retour à la liste

Numérotation des lignes : 

devlb2

  1. C DEVLB2    SOURCE    BP208322  20/09/18    21:15:37     10718          
  2.       SUBROUTINE DEVLB2(IPLIB,IPALB,XPALB,XPTB,NLIAB,IND,IDIMB,
  3.      &                  NPLB,XABSCI,XORDON,NIP)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. *                                                                    *
  8. *     Opérateur DYNE :                                               *
  9. *     Initialisation du tableau contenant les paramètres de liaison  *
  10. *                                                                    *
  11. *--------------------------------------------------------------------*
  12. *                                                                    *
  13. *     Paramètres:                                                    *
  14. *                                                                    *
  15. * e   IPALB   Renseigne sur la liaison.                              *
  16. * e/s XPALB   Tableau contenant les paramètres de la liaison.        *
  17. * e   NLIAB   Nombre de liaisons sur la base B.                      *
  18. * e   IDIMB   Nombre de directions.                                  *
  19. * e   IND     Indice du pas.                                         *
  20. *                                                                    *
  21. *--------------------------------------------------------------------*
  22.  
  23.       INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
  24.       REAL*8  XPALB(NLIAB,*),XPTB(NPLB,2,*),XPTP2(3)
  25.       REAL*8  XABSCI(NLIAB,*),XORDON(NLIAB,*)
  26. *
  27.       IND2  = IND + 1
  28. *
  29. *     Boucle sur le nombre de liaisons
  30. *
  31.       DO 10 I = 1,NLIAB
  32.          ITYP = IPALB(I,1)
  33. *
  34. * ------ choc élémentaire POINT_CERCLE_FROTTEMENT
  35. *
  36. cbp,2020         IF (ITYP.EQ.23 .OR. ITYP.EQ.24) THEN
  37. cbp,2020 : rem : il n'y avait pas 123 et 124 ???
  38.          IF (ITYP.EQ.24 .OR. ITYP.EQ.124) THEN
  39.             NPOI   = IPLIB(I,1)
  40.             IDIM   = IPALB(I,3)
  41. cbp,2020            IF (ITYP.EQ.23) THEN
  42. cbp,2020               ID1 = 6
  43. cbp,2020            ELSE
  44. cbp,2020               ID1 = 7
  45.                ID1 = 10
  46. cbp,2020            ENDIF
  47.             ID7 = ID1 + 6*IDIM
  48.             DO 230 ID=1,IDIM
  49. *   déjà effectué dans devcoi , avec prise en compte de
  50. *  la rotation initiale
  51. *               XPTB(NPOI,2,ID) = XPTB(NPOI,1,ID)
  52.                XPALB(I,ID7+ID) = XPTB(NPOI,1,ID)
  53.  230           CONTINUE
  54. *           end do
  55.  
  56.  
  57. *
  58. * ------ choc élémentaire POINT_CERCLE_MOBILE
  59. *
  60.          ELSE IF (ITYP.EQ. 33 .OR. ITYP.EQ. 34 
  61.      &       .OR. ITYP.EQ.133 .OR. ITYP.EQ.134) THEN
  62.             NPOA   = IPLIB(I,1)
  63.             NPOB   = IPLIB(I,2)
  64.             IDIM   = IPALB(I,3)
  65.             IF (ITYP.EQ.33) THEN
  66.                ID1 = 6
  67.             ELSE
  68.                ID1 = 7
  69.             ENDIF
  70.             ID7 = ID1 + 6*IDIM
  71.             DO 330 ID=1,IDIM
  72. *               XPTB(NPOa,2,ID) = XPTB(NPOa,1,ID)
  73. *               XPTB(NPOb,2,ID) = XPTB(NPOb,1,ID)
  74.                XPALB(I,ID7+ID) = XPTB(NPOa,1,ID)
  75.      &                         - XPTB(NPOb,1,ID)
  76.  330           CONTINUE
  77.  
  78. *
  79. * ------ choc élémentaire CERCLE_CERCLE_FROTTEMENT
  80. *
  81.          ELSE IF (ITYP.EQ. 25 .OR. ITYP.EQ. 26
  82.      &       .OR. ITYP.EQ.125 .OR. ITYP.EQ.126) THEN
  83.             NPOI   = IPLIB(I,1)
  84.             IDIM   = IPALB(I,3)
  85.             IF (ITYP.EQ.25) THEN
  86.                ID1 = 6
  87.             ELSE
  88.                ID1 = 7
  89.             ENDIF
  90.             ID2  = ID1 + IDIM
  91.             ID3  = ID1 + 2*IDIM
  92.             ID7  = ID1 + 6*IDIM
  93.             ID10 = ID1 + 9*IDIM
  94.             XRAYT = XPALB(I,ID10+1)
  95. *  Calcul du déplacement du point fibre neutre dans le plan du cercle
  96. *  Calcul de la normale de choc
  97.             PSXPN = 0.D0
  98.             DO 250 ID = 1,IDIM
  99.                PSXPN = PSXPN + ( XPTB(NPOI,1,ID) * XPALB(I,ID1+ID) )
  100.  250           CONTINUE
  101. *           end do
  102.             PSXPME = 0.D0
  103.             DO 252 ID = 1,IDIM
  104.             XXPME = ( XPTB(NPOI,1,ID) - ( PSXPN * XPALB(I,ID1+ID) ) )
  105.      &                                  - XPALB(I,ID2+ID)
  106.                XPALB(I,ID3+ID) = XXPME
  107.                PSXPME = PSXPME + ( XXPME * XXPME )
  108.  252            CONTINUE
  109. *           end do
  110.             PSXPME = SQRT(PSXPME)
  111.             IF (PSXPME.GT.1D-20) THEN
  112.                DO 254 ID = 1,IDIM
  113.                   XPALB(I,ID3+ID) = XPALB(I,ID3+ID) / PSXPME
  114.  254              CONTINUE
  115. *              end do
  116.             ENDIF
  117. *  Calcul du déplacement du point de contact au pas courant
  118.             XPTP2(1) = XPTB(NPOI,1,1) +
  119.      &               (                      XPALB(I,ID3+1) * XRAYT )
  120.             XPTP2(2) = XPTB(NPOI,1,2) +
  121.      &               (                      XPALB(I,ID3+2) * XRAYT )
  122.             XPTP2(3) = XPTB(NPOI,1,3) +
  123.      &               (                      XPALB(I,ID3+3) * XRAYT )
  124. *  Initialisation de la position origine adherence
  125.             DO 256 ID=1,IDIM
  126. *               XPTB(NPOI,2,ID) = XPTB(NPOI,1,ID)
  127.                XPALB(I,ID7+ID) = XPTP2(ID)
  128.  256           CONTINUE
  129. *           end do
  130.  
  131. *
  132. * ------ choc élémentaire POINT_POINT_FROTTEMENT
  133. *
  134.          ELSE IF ((abs(ITYP)).EQ.13 .OR. ITYP.EQ.113) THEN
  135.             NPOa   = IPLIB(I,1)
  136.             NPOb   = IPLIB(I,2)
  137.             IDIM   = IPALB(I,3)
  138.             ID1 = 7
  139.             ID5 = ID1 + 4*IDIM
  140.             DO 31 ID=1,IDIM
  141. *               XPTB(NPOa,2,ID) = XPTB(NPOa,1,ID)
  142. *               XPTB(NPOb,2,ID) = XPTB(NPOb,1,ID)
  143.                XPALB(I,ID5+ID) = XPTB(NPOa,1,ID)
  144.      &                         - XPTB(NPOb,1,ID)
  145.  31            CONTINUE
  146.  
  147. *
  148. * ------ choc élémentaire POINT_PLAN_FROTTEMENT
  149. *
  150.          ELSE IF (ITYP.EQ.3  .OR. ITYP.EQ.103 ) THEN
  151.             NPOI   = IPLIB(I,1)
  152.             IDIM   = IPALB(I,3)
  153. c             ID1 = 7
  154. c             ID5 = ID1 + 4*IDIM
  155.             ID1 = 9
  156.             ID5 = ID1 + 5*IDIM
  157. c           position au debut de l'adherence ?
  158.             DO 30 ID=1,IDIM
  159. *               XPTB(NPOI,2,ID) = XPTB(NPOI,1,ID)
  160.                XPALB(I,ID5+ID) = XPTB(NPOI,1,ID)
  161.  30            CONTINUE
  162. *           end do
  163. *
  164. * ------ choc élémentaire CERCLE_PLAN_FROTTEMENT
  165. *
  166.          ELSE IF (ITYP.EQ.5 .OR. ITYP.EQ.6) THEN
  167.             NPOI   = IPLIB(I,1)
  168.             IDIM   = IPALB(I,3)
  169.             IF (ITYP.EQ.5) THEN
  170.                ID1 = 6
  171.             ELSE
  172.                ID1 = 7
  173.             ENDIF
  174.             ID5 = ID1 + 4*IDIM
  175.             ID8 = ID1 + 7*IDIM
  176.             XRAYT = XPALB(I,ID8+1)
  177. * calcul du déplacement du point de contact au pas courant
  178.             XPTP2(1) = XPTB(NPOI,1,1) +
  179.      &               ( ( XPTB(NPOI,1,5) * XPALB(I,ID1+3) * XRAYT ) -
  180.      &                 ( XPTB(NPOI,1,6) * XPALB(I,ID1+2) * XRAYT ) )
  181.             XPTP2(2) = XPTB(NPOI,1,2) +
  182.      &               ( ( XPTB(NPOI,1,6) * XPALB(I,ID1+1) * XRAYT ) -
  183.      &                 ( XPTB(NPOI,1,4) * XPALB(I,ID1+3) * XRAYT ) )
  184.             XPTP2(3) = XPTB(NPOI,1,3) +
  185.      &               ( ( XPTB(NPOI,1,4) * XPALB(I,ID1+2) * XRAYT ) -
  186.      &                 ( XPTB(NPOI,1,5) * XPALB(I,ID1+1) * XRAYT ) )
  187.             DO 50 ID = 1,IDIM
  188. *               XPTB(NPOI,2,ID) = XPTB(NPOI,1,ID)
  189.                XPALB(I,ID5+ID) = XPTP2(ID)
  190.  50            CONTINUE
  191. *           end do
  192. *
  193. * ------ choc élémentaire POINT_PLAN_FLUIDE
  194. *
  195.          ELSE IF (ITYP.EQ.7) THEN
  196.             IDIM   = IPALB(I,3)
  197.             ID1 = 6 + IDIM
  198.             XPALB(I,ID1+1) = 0.D0
  199.             XPALB(I,ID1+2) = 0.D0
  200.             XPALB(I,ID1+3) = 0.D0
  201.  
  202. * ------ choc élémentaire POINT_PLAN avec SEUIL_PLASTIQUE ?
  203. **  ianis
  204.          ELSE IF (ITYP.EQ.100) THEN
  205.             XPALB(I,(5 + IDIMB)) = 0.D0
  206.  
  207. *
  208. * ------ choc elementaire POINT_POINT_ ... _PLASTIQUE
  209. *
  210.          ELSE IF (ITYP.EQ.16 .OR. ITYP.EQ.50) THEN
  211.             IDIM   = IPALB(I,3)
  212.             XPALB(I,2+IDIM) = 0.D0
  213.             XPALB(I,3+IDIM) = XABSCI(I,2)
  214.             XPALB(I,4+IDIM) = 0.D0
  215. *
  216.          ELSE IF (ITYP.EQ.17 .OR. ITYP.EQ.51) THEN
  217.             IDIM   = IPALB(I,3)
  218.             XPALB(I,3+IDIM) = 0.D0
  219.             XPALB(I,4+IDIM) = XABSCI(I,2)
  220.             XPALB(I,5+IDIM) = 0.D0
  221.  
  222. *
  223. * ------ choc élémentaire LIGNE_LIGNE_FROTTEMENT
  224. *
  225.          ELSE IF (ITYP.EQ.35.OR.ITYP.EQ.36) THEN
  226.             NNOEMA = IPALB(I,21)
  227.             NNOEES = IPALB(I,22)
  228. *   Initialisation de la recherche du noeud maitre voisin
  229.             IGLOBA = 1
  230.             DO 340 INOE=1,NNOEES
  231.                CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,
  232.      &                  NPLB,IGLOBA,0)
  233.  340        CONTINUE
  234.             DO 342 INOE=1,NNOEMA
  235.                CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,
  236.      &             NPLB,IGLOBA,1)
  237.  342        CONTINUE
  238.  
  239. *
  240. * ------ choc élémentaire LIGNE_CERCLE
  241. *
  242.          ELSE IF (ITYP.EQ.37.OR.ITYP.EQ.38
  243.      & .OR. ITYP.EQ.39.OR.ITYP.EQ.40) THEN
  244.             NNOEMA = IPALB(I,21)
  245.             NNOEES = IPALB(I,22)
  246. *   Initialisation de la recherche du noeud maitre voisin
  247.             IGLOBA = 1
  248.             DO 440 INOE=1,NNOEES
  249.                CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,
  250.      &                  NPLB,IGLOBA,0)
  251.  440        CONTINUE
  252.             DO 442 INOE=1,NNOEMA
  253.                CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,
  254.      &             NPLB,IGLOBA,1)
  255.  442        CONTINUE
  256.  
  257.  
  258. * ------ choc ...........
  259. *
  260. *        ELSE IF (ITYP.EQ.  ) THEN
  261. *              .......
  262. *              .......
  263. *
  264.          ENDIF
  265.  10      CONTINUE
  266.  
  267. *     end do
  268. *
  269.       END
  270.  
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  

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