Télécharger la plaquette Cast3M


fr en

Télécharger devfb2.eso

Retour à la liste

Numérotation des lignes : 

devfb2

  1. C DEVFB2    SOURCE    BP208322  20/09/18    21:15:27     10718          
  2.  
  3.       SUBROUTINE DEVFB2(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  4.      &                  NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  5.      &                  FEXPSM,NPC1,XABSCI,XORDON,NIP,I,iannul)
  6.  
  7. *--------------------------------------------------------------------*
  8. *                                                                    *
  9. *     Operateur DYNE et DYNC :                                       *
  10. *     Calcul des forces de choc pour les liaisons B de type :        *
  11. *     - POINT_POINT avec ou sans amortissement                       *
  12. *     - POINT_POINT_FROTTEMENT avec ou sans amortissement            *
  13. *                                                                    *
  14. *--------------------------------------------------------------------*
  15. *                                                                    *
  16. *     Parametres:                                                    *
  17. *                                                                    *
  18. * e   ITYP    type de la liaison.                                    *
  19. * es  FTOTB   Forces exterieures totalisees sur la base B.           *
  20. * e   XPTB    Tableau des deplacements des points                    *
  21. * e   IPALB   Renseigne sur la liaison.                              *
  22. * e   IPLIB   Tableau contenant les numeros "DYNE" de la liaison.    *
  23. * e   XPALB   Tableau contenant les parametres de la liaison.        *
  24. * es  XVALB   Tableau contenant les variables internes de liaisons.  *
  25. * e   NLIAB   Nombre de liaisons sur la base B.                      *
  26. * e   NPLB    Nombre total de points intervenant dans les liaisons.  *
  27. * e   IND     Indice du pas.                                         *
  28. * e   I       numero de la liaison.                                  *
  29. *                                                                    *
  30. *--------------------------------------------------------------------*
  31.  
  32.       IMPLICIT INTEGER(I-N)
  33.       IMPLICIT REAL*8(A-H,O-Z)
  34. *
  35.       INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
  36.       REAL*8  XPALB(NLIAB,*),XPTB(NPLB,2,*),FTOTB(NPLB,*)
  37.       REAL*8  XVALB(NLIAB,4,*),FEXPSM(NPLB,NPC1,2,*)
  38.       REAL*8  XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  39. *
  40. *
  41. *--------------------------------------------------------------------*
  42. * --- choc elementaire POINT_POINT avec amortissement
  43. *--------------------------------------------------------------------*
  44. *
  45.       IF (ITYP.EQ.11 .OR. ITYP.EQ.111) THEN
  46.          NPOA   = IPLIB(I,1)
  47.          NPOB   = IPLIB(I,2)
  48.          IDIM   = IPALB(I,3)
  49.          IPERM  = IPALB(I,4)
  50.          XRAID  = XPALB(I,1)
  51.          XJEU   = XPALB(I,2)
  52.          XAMO   = XPALB(I,3)
  53.          ETA    = 0.D0
  54.          XDEP = 0.D0
  55. cbp,2020-09         XDEPM1 = 0.D0
  56.          XVIT   = 0.D0
  57.          DO 20 ID = 1,IDIM
  58.             IDA = 3 + ID
  59.             IDB = 3 + IDIM + ID
  60.             XDEA = XPTB(NPOA,1,ID)
  61. cbp,2020-09            XDMA = XPTB(NPOA,IND2,ID)
  62.             XVIA = XPTB(NPOA,2,ID)
  63.             XDEB = XPTB(NPOB,1,ID)
  64. cbp,2020-09            XDMB = XPTB(NPOB,IND2,ID)
  65.             XVIB = XPTB(NPOB,2,ID)
  66.             XVALB(I,IND,IDA) = XDEA
  67.             XVALB(I,IND,IDB) = XDEB
  68.             XDEA = XDEA + FEXPSM(NPOA,NPA,IND1,ID)
  69.             XDEB = XDEB + FEXPSM(NPOB,NPA,IND1,ID)
  70. cbp,2020-09            XDMA = XDMA + FEXPSM(NPOA,NPAM1,INDM1,ID)
  71. cbp,2020-09            XDMB = XDMB + FEXPSM(NPOB,NPAM1,INDM1,ID)
  72.             XDEP = XDEP + (XDEA - XDEB) * XPALB(I,3+ID)
  73. cbp,2020-09            XDEPM1 = XDEPM1 + (XDMA - XDMB) * XPALB(I,3+ID)
  74.             XVIT = XVIT + (XVIA - XVIB) * XPALB(I,3+ID)
  75.  20      CONTINUE
  76. cbp,2020-09         XVIT = (XDEP - XDEPM1) / PDTS2
  77.          XVALB(I,IND,3) = XVIT
  78.          IF (ITYP.EQ.11) THEN
  79.            CALL DYCHAM(XDEP,XVIT,XRAID,XJEU,XAMO,ETA,
  80.      &                 XFLA,DFDX,DFDV,IPERM,iannul)
  81.          ELSE
  82.            CALL DYCHAM2(XDEP,XVIT,XJEU,XAMO,XABSCI,XORDON,NIP,
  83.      &                  NLIAB,I, XFLA,IPERM,iannul)
  84.          ENDIF
  85.          XFLB = -1.D0 * XFLA
  86.          XVALB(I,IND,1) = XFLA
  87.          XVALB(I,IND,2) = XFLB
  88.          DO 22 ID = 1,IDIM
  89.             FTOTB(NPOA,ID) = FTOTB(NPOA,ID) + XFLA * XPALB(I,3+ID)
  90.             FTOTB(NPOB,ID) = FTOTB(NPOB,ID) + XFLB * XPALB(I,3+ID)
  91.  22      CONTINUE
  92. *
  93. *--------------------------------------------------------------------*
  94. * --- choc elementaire POINT_POINT_FROTTEMENT avec ou sans amortissement
  95. *--------------------------------------------------------------------*
  96. *
  97.       ELSEIF ((ITYP.EQ.13) .or. ( ityp .eq. 113)) THEN
  98.          NPOA   = IPLIB(I,1)
  99.          NPOB   = IPLIB(I,2)
  100.          IGP    = IPALB(I,2)
  101.          IDIM   = IPALB(I,3)
  102.          ID1 = 7
  103.          ID2 = ID1 + IDIM
  104.          ID3 = ID1 + 2*IDIM
  105.          ID4 = ID1 + 3*IDIM
  106.          ID5 = ID1 + 4*IDIM
  107.          ID6 = ID1 + 5*IDIM
  108.          ID7 = ID1 + 6*IDIM
  109. *  Si glissement au pas precedent, reactualisation de la position-ecart
  110. *  origine d'adherence
  111.          IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
  112.             DO 30 ID=1,IDIM
  113.                XPALB(I,ID5+ID) =(XPTB(NPOa,1,ID) +
  114.      &                           FEXPSM(NPOa,NPA,IND1,ID) )
  115.      &                       - ( XPTB(NPOb,1,ID) +
  116.      &                           FEXPSM(NPOb,NPA,IND1,ID))
  117.  30         CONTINUE
  118.          ENDIF
  119. *  Calcul de l'enfoncement relatif et de la vitesse normale relative
  120.          XDEP = 0.D0
  121.          XVITN= 0.D0
  122.          PSN0 = 0.D0
  123.          DO 32 ID = 1,IDIM
  124.             IDD1 = 3 + ID
  125.             xvalb(i,ind,idd1) = XPTB(NPOa,1,ID)
  126.             xvalb(i,ind,idd1 + idim) = XPTB(NPOb,1,ID)
  127.             XDE2 = XPTB(NPOa,1,ID)  - XPTB (NPOb,1,ID)
  128.             XDE2 = XDE2 + FEXPSM(NPOa,NPA,IND1,ID)
  129.      &                  - FEXPSM(NPOb,NPA,IND1,ID)
  130. cbp,2020-09            XDM2 = XPTB(NPOa,IND2,ID) - XPTB (NPOb,IND2,ID)
  131. cbp,2020-09            XDM2 = XDM2 + FEXPSM(NPOA,NPAM1,INDM1,ID)
  132. cbp,2020-09     &                  - FEXPSM(NPOb,NPAM1,INDM1,ID)
  133. cbp,2020-09            XPALB(I,ID2+ID) = XDE2 - XDM2
  134.             XPALB(I,ID2+ID) = XPTB(NPOa,2,ID) - XPTB (NPOb,2,ID)
  135.             XPALB(I,ID3+ID) = XDE2 - XPALB(I,ID5+ID)
  136.             XDEP = XDEP + XDE2 * XPALB(I,ID1+ID)
  137.             XVITN= XVITN+ XPALB(I,ID2+ID) * XPALB(I,ID1+ID)
  138.             PSN0 = PSN0 + XPALB(I,ID3+ID) * XPALB(I,ID1+ID)
  139.  32      CONTINUE
  140. *  Projette la vitesse relative
  141. * et la variation de deplacement relatif par rapport a
  142. *  l' ecart origine d'adherence sur le plan tangent
  143.          DO 34 ID = 1,IDIM
  144.             XPALB(I,ID2+ID) = (XPALB(I,ID2+ID) - XVITN*XPALB(I,ID1+ID))
  145. cbp,2020-09     &                        / PDTS2
  146.             XPALB(I,ID3+ID) = XPALB(I,ID3+ID) - PSN0 * XPALB(I,ID1+ID)
  147.  34      CONTINUE
  148. cbp,2020-09         XVITN = PSN / PDTS2
  149.          XVALB(I,IND,3) = XVITN
  150.          IF (ITYP.EQ.13) THEN
  151.            CALL DYCHA4(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,XFN,XFT,XPUS
  152.      &                  ,iannul)
  153.          ELSE
  154.            CALL DYCHA41(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,XFN,XFT,XPUS,
  155.      &                  XABSCI,XORDON,NIP,iannul)
  156.          ENDIF
  157.  
  158.          Xfla           = XFN
  159.          Xflb           =  -1d0 * XFN
  160.          XVALB(I,IND,1) = XFla
  161.          XVALB(I,IND,2) = XFlb
  162.          XVALB(I,IND,10) = ABS(XFT)
  163.          XVALB(I,IND,12) = XPUS
  164.          IPALB(I,2) = IGP
  165. *  Si glissement, memorisation de la vitesse tangentielle et de la force
  166. *  tangentielle
  167.          IF (IGP.EQ.1.OR.IGP.EQ.-1) THEN
  168.             DO 36 ID = 1,IDIM
  169.                XPALB(I,ID6+ID) = XPALB(I,ID2+ID)
  170.                XPALB(I,ID7+ID) = XPALB(I,ID4+ID)
  171.  36      CONTINUE
  172.          ENDIF
  173.          DO 38 ID = 1,IDIM
  174.             FTOTB(NPOa,ID) = FTOTB(NPOa,ID) + XFla* XPALB(I,ID1+ID)
  175.      &                                      + XPALB(I,ID4+ID)
  176.             FTOTB(NPOb,ID) = FTOTB(NPOb,ID) + XFlb* XPALB(I,ID1+ID)
  177.      &                                      - XPALB(I,ID4+ID)
  178.  38      CONTINUE
  179.  
  180. *****************************************************************
  181.  
  182.  
  183. *--------------------------------------------------------------------*
  184. ** modele de Nedjai. On ne garantit rien --> a supprimer ?
  185. *--------------------------------------------------------------------*
  186.  
  187.       ELSEIF (ITYP.EQ.-13)  THEN
  188.          NPOA   = IPLIB(I,1)
  189.          NPOB   = IPLIB(I,2)
  190.          IGP    = IPALB(I,2)
  191.          IDIM   = IPALB(I,3)
  192.          ID1 = 7
  193.          ID2 = ID1 + IDIM
  194.          ID3 = ID1 + 2*IDIM
  195.          ID4 = ID1 + 3*IDIM
  196.          ID5 = ID1 + 4*IDIM
  197.          ID6 = ID1 + 5*IDIM
  198.          ID7 = ID1 + 6*IDIM
  199. *  Si glissement au pas precedent, reactualisation de la position-ecart
  200. *  origine d'adherence
  201.          IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
  202.             DO 130 ID=1,IDIM
  203.                XPALB(I,ID5+ID) =(XPTB(NPOa,1,ID) +
  204.      &                           FEXPSM(NPOa,NPA,IND1,ID) )
  205.      &                       - ( XPTB(NPOb,1,ID) +
  206.      &                           FEXPSM(NPOb,NPA,IND1,ID))
  207. 130         CONTINUE
  208.          ENDIF
  209. *  Calcul de l'enfoncement relatif et de la vitesse normale relative
  210.          XDEP = 0.D0
  211.          XVITN= 0.D0
  212.          PSN0 = 0.D0
  213.          DO 132 ID = 1,IDIM
  214.             IDD1 = 3 + ID
  215.             xvalb(i,ind,idd1) = XPTB(NPOa,1,ID)
  216.             xvalb(i,ind,idd1 + idim) = XPTB(NPOb,1,ID)
  217.             XDE2 = XPTB(NPOA,1,ID)  - XPTB (NPOB,1,ID)
  218.             XDE2 = XDE2 + FEXPSM(NPOa,NPA,IND1,ID)
  219.      &                  - FEXPSM(NPOb,NPA,IND1,ID)
  220. cbp,2020-09            XDm2 = XPTB(NPOa,IND2,ID) - xptb (npob,ind2,id)
  221. cbp,2020-09            XDM2 = XDM2 + FEXPSM(NPOA,NPAM1,INDM1,ID)
  222. cbp,2020-09     &                  - FEXPSM(NPOb,NPAM1,INDM1,ID)
  223. cbp,2020-09            XPALB(I,ID2+ID) = XDE2 - XDM2
  224.             XPALB(I,ID2+ID) = XPTB(NPOa,2,ID) - xptb (npob,2,id)
  225. *A ENLEVER**XPALB(I,ID3+ID) = XDE2 - XPALB(I,ID5+ID)
  226.             XDEP = XDEP + XDE2 * XPALB(I,ID1+ID)
  227.             XVITN= XVITN+ XPALB(I,ID2+ID) * XPALB(I,ID1+ID)
  228.             PSN0 = PSN0 + XPALB(I,ID3+ID) * XPALB(I,ID1+ID)
  229. 132      CONTINUE
  230. *  Projette la vitesse relative
  231. * et la variation de deplacement relatif par rapport a
  232. *  l' ecart origine d'adherence sur le plan tangent
  233.          DO 134 ID = 1,IDIM
  234.             XPALB(I,ID2+ID) = (XPALB(I,ID2+ID) - XVITN*XPALB(I,ID1+ID))
  235. cbp,2020-09     &                        / PDTS2
  236. *A enlever**XPALB(I,ID3+ID) = XPALB(I,ID3+ID) - PSN0 * XPALB(I,ID1+ID)
  237. 134      CONTINUE
  238. cbp,2020-09         XVITN = PSN / PDTS2
  239.          XVALB(I,IND,3) = XVITN
  240.  
  241. ***RAJOUT DE XPAS DANS CALL DYCHA4
  242.            CALL DGCHA4(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,XFN,XFT,XPUS
  243.      &                  ,iannul,PDTS2)
  244.  
  245.  
  246.          Xfla           = XFN
  247.          Xflb           =  -1d0 * XFN
  248.          XVALB(I,IND,1) = XFla
  249.          XVALB(I,IND,2) = XFlb
  250.          XVALB(I,IND,10) = ABS(XFT)
  251.          XVALB(I,IND,12) = XPUS
  252.          IPALB(I,2) = IGP
  253. *  Si glissement, memorisation de la vitesse tangentielle et de la force
  254. *  tangentielle
  255. *AENLEV**IF (IGP.EQ.1.OR.IGP.EQ.-1) THEN
  256.             DO 136 ID = 1,IDIM
  257. **ON A REMPLACE ID6 PAR ID3 (NEDJAI)
  258.                XPALB(I,ID3+ID) = XPALB(I,ID2+ID)
  259.                XPALB(I,ID7+ID) = XPALB(I,ID4+ID)
  260. 136         CONTINUE
  261. **AENLEV**ENDIF
  262.          DO 138 ID = 1,IDIM
  263.             FTOTB(NPOa,ID) = FTOTB(NPOa,ID) + XFla* XPALB(I,ID1+ID)
  264.      &                                      + XPALB(I,ID4+ID)
  265.             FTOTB(NPOb,ID) = FTOTB(NPOb,ID) + XFlb* XPALB(I,ID1+ID)
  266.      &                                      - XPALB(I,ID4+ID)
  267. 138      CONTINUE
  268.  
  269. *
  270. * --- choc ...........
  271. *
  272. *     ELSE IF (ITYP.EQ.  ) THEN
  273. *        .......
  274. *        .......
  275. *
  276.       ENDIF
  277. *
  278.       END
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  
  285.  
  286.  
  287.  
  288.  
  289.  

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