Télécharger la plaquette Cast3M


fr en

Télécharger dyne14.eso

Retour à la liste

Numérotation des lignes : 

dyne14

  1. C DYNE14    SOURCE    BP208322  20/03/26    21:15:53     10562          
  2.       SUBROUTINE DYNE14(ITREFR,KTLIAB)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. *                                                                    *
  7. *     Operateur DYNE :                                               *
  8. *     Remplissage du tableau contenant les paramètres de liaison en  *
  9. *     cas de reprise.                                                *
  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   IDIM    Nombre de directions.                                  *
  19. *                                                                    *
  20. *--------------------------------------------------------------------*
  21. *
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMCOORD
  26. -INC SMLENTI
  27.  
  28.       LOGICAL L0,L1
  29.       SEGMENT,MTLIAB
  30.          INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  31.          REAL*8  XPALB(NLIAB,NXPALB)
  32.          REAL*8  XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  33.       ENDSEGMENT
  34.  
  35.       MTLIAB = KTLIAB
  36.       NLIAB = XPALB(/1)
  37. *
  38. *--------------------------------------------------------------------*
  39. *     Boucle sur les liaisons
  40. *--------------------------------------------------------------------*
  41. *
  42.       ID0 = 0
  43.       ID1 = 0
  44.       ID2 = 0
  45.       DO 10 I = 1,NLIAB
  46.  
  47.          ITYP = IPALB(I,1)
  48.          CALL ACCTAB(ITREFR,'ENTIER',I,X0,' ',L0,IP0,
  49.      &               'TABLE',I1,X1,' ',L1,ITREFI)
  50.          IF (IERR.NE.0) RETURN
  51.          CALL ACCTAB(ITREFI,'MOT',I0,X0,'TYPE',L0,IP0,
  52.      &               'ENTIER',ITYPR,X1,' ',L1,ITR)
  53.          IF (IERR.NE.0) RETURN
  54.          IF (ITYP.NE.ITYPR) THEN
  55.             call erreur(21)
  56.             RETURN
  57.          ENDIF
  58. *
  59. * ------ choc elementaire POINT_CERCLE_MOBILE
  60. *                        sans amortissement
  61. *
  62. cbp,2020         IF (ITYP.EQ.23. OR. ITYP.EQ.33) THEN
  63.          IF (ITYP.EQ.33) THEN
  64.             IDIM = IPALB(I,3)
  65.             ID0 = 6 + 6*IDIM
  66.             ID1 = 6 + 7*IDIM
  67.             ID2 = 6 + 8*IDIM
  68.  
  69. *
  70. * ------ choc elementaire POINT_CERCLE_FROTTEMENT 
  71. *
  72.          ELSE IF (ITYP.EQ.23) THEN
  73.             IDIM = IPALB(I,3)
  74.             ID0 = 10 + 6*IDIM
  75.             ID1 = 10 + 7*IDIM
  76.             ID2 = 10 + 8*IDIM
  77. *
  78. * ------ choc elementaire POINT_CERCLE_MOBILE
  79. *                        avec amortissement
  80. *
  81. cbp,2020         ELSE IF (ITYP.EQ.24 .OR. ITYP.EQ.34) THEN
  82.          ELSE IF (ITYP.EQ.34) THEN
  83.             IDIM = IPALB(I,3)
  84.             ID0 = 7 + 6*IDIM
  85.             ID1 = 7 + 7*IDIM
  86.             ID2 = 7 + 8*IDIM
  87. *
  88. * ------ choc elementaire CERCLE_PLAN_FROTTEMENT
  89.          ELSE IF (ITYP.EQ.5) THEN
  90.             IDIM = IPALB(I,3)
  91.             ID0 = 6 + 4*IDIM
  92.             ID1 = 6 + 5*IDIM
  93.             ID2 = 6 + 6*IDIM
  94. *
  95. * ------ choc elementaire POINT_PLAN_FROTTEMENT
  96. *
  97.          ELSE IF (ITYP.EQ.3 .OR. ITYP.EQ.103 ) THEN
  98.             IDIM = IPALB(I,3)
  99. cbp,2020             ID0 = 7 + 4*IDIM
  100. cbp,2020             ID1 = 7 + 5*IDIM
  101. cbp,2020             ID2 = 7 + 6*IDIM
  102.             ID0 = 9 + 5*IDIM
  103.             ID1 = 9 + 6*IDIM
  104.             ID2 = 9 + 7*IDIM
  105. *
  106. * ------ choc elementaire POINT_POINT_FROTTEMENT 
  107. *                      et CERCLE_PLAN_FROTTEMENT avec amortissement
  108. *
  109.          ELSE IF (ITYP.EQ.13 .OR. ITYP.EQ.113 .OR. ITYP.EQ.6) THEN
  110.             IDIM = IPALB(I,3)
  111.             ID0 = 7 + 4*IDIM
  112.             ID1 = 7 + 5*IDIM
  113.             ID2 = 7 + 6*IDIM
  114.  
  115. *
  116. * ------ choc elementaire CERCLE_CERCLE_FROTTEMENT
  117. *
  118.          ELSE IF (ITYP.EQ.25 .OR. ITYP.EQ.26) THEN
  119.                   IF (ITYP.EQ.23) THEN
  120.                       IDD = 6
  121.                   ELSE
  122.                       IDD = 7
  123.                   ENDIF
  124.             IDIM = IPALB(I,3)
  125.             ID0 = IDD + 6*IDIM
  126.             ID1 = IDD + 7*IDIM
  127.             ID2 = IDD + 8*IDIM
  128.             ID3 = IDD + 2*IDIM
  129.  
  130.          CALL ACCTAB(ITREFI,'MOT',I0,X0,'POSITION_ORIGINE_ADHERENCE',
  131.      &               L0,IP0,'POINT',I1,X1,' ',L1,IPOR0)
  132.          IF (IERR.NE.0) RETURN
  133.          IPN0 = (IDIM + 1) * (IPOR0 - 1)
  134.  
  135.          CALL ACCTAB(ITREFI,'MOT',I0,X0,'VITESSE_TANGENTIELLE',L0,IP0,
  136.      &               'POINT',I1,X1,' ',L1,IPOR1)
  137.          IF (IERR.NE.0) RETURN
  138.          IPN1 = (IDIM + 1) * (IPOR1 - 1)
  139.  
  140.  
  141.          CALL ACCTAB(ITREFI,'MOT',I0,X0,'FORCE_DE_CHOC_TANGENTIELLE',
  142.      &               L0,IP0,'POINT',I1,X1,' ',L1,IPOR2)
  143.          IF (IERR.NE.0) RETURN
  144.          IPN2 = (IDIM + 1) * (IPOR2 - 1)
  145.  
  146.          CALL ACCTAB(ITREFI,'MOT',I0,X0,'NORMALE_DE_CHOC',
  147.      &               L0,IP0,'POINT',I1,X1,' ',L1,IPOR3)
  148.          IF (IERR.NE.0) RETURN
  149.          IPN3 = (IDIM + 1) * (IPOR3 - 1)
  150.  
  151.          DO 40 ID = 1,IDIM
  152.             XPALB(I,ID0+ID) = XCOOR(IPN0 + ID)
  153.             XPALB(I,ID1+ID) = XCOOR(IPN1 + ID)
  154.             XPALB(I,ID2+ID) = XCOOR(IPN2 + ID)
  155.             XPALB(I,ID3+ID) = XCOOR(IPN3 + ID)
  156.  40         CONTINUE
  157. *        end do
  158.  
  159.          CALL ACCTAB(ITREFI,'MOT',I0,X0,'ETAT_DU_FROTTEMENT',L0,IP0,
  160.      &               'ENTIER',IGP,X1,' ',L1,IRP)
  161.          IF (IERR.NE.0) RETURN
  162.          IPALB(I,2) = IGP
  163. *
  164.             GOTO 10
  165.  
  166. *
  167. *
  168. *
  169. * ------ choc elementaire POINT_PLAN_FLUIDE
  170. *
  171.          ELSE IF (ITYP.EQ.7) THEN
  172.             IDIM = IPALB(I,3)
  173.             ID1 = 6 + IDIM
  174.             CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_1/2',L0,IP0,
  175.      &                         'POINT',I1,X1,' ',L1,IPDEP)
  176.             IF (IERR.NE.0) RETURN
  177.             CALL ACCTAB(ITREFI,'MOT',I0,X0,'VITESSE_1/2',L0,IP0,
  178.      &                         'POINT',I1,X1,' ',L1,IPVIT)
  179.             IF (IERR.NE.0) RETURN
  180.             CALL ACCTAB(ITREFI,'MOT',I0,X0,'ACCELERATION_1/2',L0,IP0,
  181.      &                         'POINT',I1,X1,' ',L1,IPACC)
  182.             IF (IERR.NE.0) RETURN
  183.             IPND = (IDIM + 1) * (IPDEP - 1)
  184.             IPNV = (IDIM + 1) * (IPVIT - 1)
  185.             IPNA = (IDIM + 1) * (IPACC - 1)
  186.             XPALB(I,ID1+1) = XCOOR(IPND + 1)
  187.             XPALB(I,ID1+2) = XCOOR(IPNV + 1)
  188.             XPALB(I,ID1+3) = XCOOR(IPNA + 1)
  189.             GOTO 10
  190. ** ianis
  191. *
  192. * ------ choc elementaire POINT_PLAN avec plasticite
  193. *
  194.          ELSE IF (ITYP.EQ.100 .OR. ITYP.EQ.101 ) THEN
  195. C  chargement du deplacement  plastique
  196.          CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_PLASTIQUE',
  197.      &               L0,IP0,'FLOTTANT',I1,XDPLAS,' ',L1,IPOR2)
  198.          IF (IERR.NE.0) RETURN
  199.           IDIM   = IPALB(I,3)
  200.           id1 = 4
  201.           XPALB(I,(ID1+IDIM+1)) = XDPLAS
  202.           GOTO 10
  203. *
  204. * ------ choc elementaire POINT_POINT_DEPLACEMENT_PLASTIQUE
  205. *
  206.          ELSE IF (ITYP.EQ.16 .OR. ITYP.EQ.17) THEN
  207. C  chargement du deplacement plastique et de la limite elastique
  208.          CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_PLASTIQUE',
  209.      &               L0,IP0,'FLOTTANT',I1,XDPLAS,' ',L1,IPOR2)
  210.          IF (IERR.NE.0) RETURN
  211. *
  212. * le depl limite elastique ne sert plus a rien
  213.          CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_LIMITE_ELASTIQUE',
  214.      &               L0,IP0,'FLOTTANT',I1,XELA,' ',L1,IPOR2)
  215.          IF (IERR.NE.0) RETURN
  216.          CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_PLASTIQUE_CUMULE',
  217.      &               L0,IP0,'FLOTTANT',I1,XDPLAC,' ',L1,IPOR2)
  218.          IF (IERR.NE.0) RETURN
  219.           idim =  IPALB(I,3)
  220.           if (ityp.eq.16) nn = 4 + idim
  221.           if (ityp.eq.17) nn = 5 + idim
  222.           XPALB(I,nn-2) = XDPLAS
  223.           XPALB(I,nn-1) = XELA
  224.           XPALB(I,nn) = XDPLAC
  225.           GOTO 10
  226. *
  227. * ------ choc elementaire POINT_POINT_ROTATION_PLASTIQUE
  228. *
  229.          ELSE IF (ITYP.EQ.50 .OR. ITYP.EQ.51) THEN
  230. *  chargement de la rotation plastique et de la limite elastique
  231.          CALL ACCTAB(ITREFI,'MOT',I0,X0,'ROTATION_PLASTIQUE',
  232.      &               L0,IP0,'FLOTTANT',I1,XDPLAS,' ',L1,IPOR2)
  233.          IF (IERR.NE.0) RETURN
  234. *
  235. * la rot limite elastique ne sert plus a rien
  236.          CALL ACCTAB(ITREFI,'MOT',I0,X0,'ROTATION_LIMITE_ELASTIQUE',
  237.      &               L0,IP0,'FLOTTANT',I1,XELA,' ',L1,IPOR2)
  238.          IF (IERR.NE.0) RETURN
  239.          CALL ACCTAB(ITREFI,'MOT',I0,X0,'ROTATION_PLASTIQUE_CUMULE',
  240.      &               L0,IP0,'FLOTTANT',I1,XDPLAC,' ',L1,IPOR2)
  241.          IF (IERR.NE.0) RETURN
  242.           idim =  IPALB(I,3)
  243.           if (ityp.eq.50) nn = 4 + idim
  244.           if (ityp.eq.51) nn = 5 + idim
  245.           XPALB(I,nn-2) = XDPLAS
  246.           XPALB(I,nn-1) = XELA
  247.           XPALB(I,nn) = XDPLAC
  248.  
  249.           GOTO 10
  250. C
  251. * -------choc elementaire LIGNE_LIGNE_FROTTEMENT
  252. *
  253.          ELSE IF (ITYP.EQ.35.OR.ITYP.EQ.36) THEN
  254. *   Chargement des noeudS leS plus proche
  255.             CALL ACCTAB(ITREFI,'MOT',I0,X0,'NOEUDS_VOISINS',L0,IP0,
  256.      &                  'LISTENTI',I1,X1,' ',L1,IVOIS1)
  257.             IF (IERR.NE.0) RETURN
  258.             MLENTI = IVOIS1
  259.             SEGACT,MLENTI
  260.             NNOE=LECT(/1)
  261.             DO 30 JVOI=1,NNOE
  262.                IPALB(I,26+JVOI)=LECT(JVOI)
  263.  30         CONTINUE
  264.             SEGDES,MLENTI
  265.  
  266.  
  267. * -------chocS elementaireS SEGMENT_CERCLE_FROTTEMENT_sanreac ET ..._REACNOR
  268. *
  269.          ELSE IF (ITYP.EQ.37 .OR. ITYP.EQ.38
  270.      & .OR. ITYP.EQ.39 .OR. ITYP.EQ.40) THEN
  271. *   Chargement des noeudS leS plus proche
  272.             CALL ACCTAB(ITREFI,'MOT',I0,X0,'NOEUDS_VOISINS',L0,IP0,
  273.      &                  'LISTENTI',I1,X1,' ',L1,IVOIS1)
  274.             IF (IERR.NE.0) RETURN
  275.             MLENTI = IVOIS1
  276.             SEGACT,MLENTI
  277.             NNOE=LECT(/1)
  278.             DO 32 JVOI=1,NNOE
  279.                IPALB(I,26+JVOI)=LECT(JVOI)
  280.  32         CONTINUE
  281.             SEGDES,MLENTI
  282.  
  283.  
  284.  
  285.  
  286. *
  287. *
  288. *
  289. * ------ choc ....
  290. *
  291. *        ELSE IF (ITYP.EQ.  ) THEN
  292. *           ...
  293. *
  294. *
  295.          ELSE
  296.             GOTO 10
  297.          ENDIF
  298. *
  299.         IF (ITYP.NE.35 .AND. ITYP.NE.36 .AND. ITYP.NE.37
  300.      & .AND. ITYP.NE.38 .AND. ITYP.NE.39 .AND. ITYP.NE.40) THEN
  301. *
  302. *  Chargement de la position origine d'adherence
  303. *
  304.          CALL ACCTAB(ITREFI,'MOT',I0,X0,'POSITION_ORIGINE_ADHERENCE',
  305.      &               L0,IP0,'POINT',I1,X1,' ',L1,IPOR0)
  306.          IF (IERR.NE.0) RETURN
  307.          IPN0 = (IDIM + 1) * (IPOR0 - 1)
  308. *
  309. *  Chargement de la vitesse tangentielle
  310. *
  311.          CALL ACCTAB(ITREFI,'MOT',I0,X0,'VITESSE_TANGENTIELLE',L0,IP0,
  312.      &               'POINT',I1,X1,' ',L1,IPOR1)
  313.          IF (IERR.NE.0) RETURN
  314.          IPN1 = (IDIM + 1) * (IPOR1 - 1)
  315. *
  316. *  Chargement de la force tangentielle
  317. *
  318.          CALL ACCTAB(ITREFI,'MOT',I0,X0,'FORCE_DE_CHOC_TANGENTIELLE',
  319.      &               L0,IP0,'POINT',I1,X1,' ',L1,IPOR2)
  320.          IF (IERR.NE.0) RETURN
  321.          IPN2 = (IDIM + 1) * (IPOR2 - 1)
  322.          DO 20 ID = 1,IDIM
  323.             XPALB(I,ID0+ID) = XCOOR(IPN0 + ID)
  324.             XPALB(I,ID1+ID) = XCOOR(IPN1 + ID)
  325.             XPALB(I,ID2+ID) = XCOOR(IPN2 + ID)
  326.  20         CONTINUE
  327. *        end do
  328.          ENDIF
  329. *
  330. *  Chargement de l'etat tangentiel de la liaison
  331. *
  332.          CALL ACCTAB(ITREFI,'MOT',I0,X0,'ETAT_DU_FROTTEMENT',L0,IP0,
  333.      &               'ENTIER',IGP,X1,' ',L1,IRP)
  334.          IF (IERR.NE.0) RETURN
  335.          IPALB(I,2) = IGP
  336. *
  337.  10      CONTINUE
  338.  
  339.  
  340. *     end do
  341. *
  342.       END
  343.  
  344.  
  345.  
  346.  
  347.  
  348.  
  349.  
  350.  
  351.  
  352.  
  353.  
  354.  
  355.  
  356.  

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