Télécharger la plaquette Cast3M


fr en

Télécharger devfb6.eso

Retour à la liste

Numérotation des lignes : 

devfb6

  1. C DEVFB6    SOURCE    BP208322  20/09/18    21:15:31     10718          
  2.       SUBROUTINE DEVFB6(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  3.      &                  NPLB,IND,IND2,PDTS2,I,iannul,XCHPFB)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. *                                                                    *
  8. *     Opérateur DYNE : algorithme de Fu - de Vogelaere               *
  9. *     ________________________________________________               *
  10. *                                                                    *
  11. *     Calcul des forces de choc sur base B pour les liaisons de      *
  12. *     type LIGNE_LIGNE                                               *
  13. *                                                                    *
  14. *     Paramètres:                                                    *
  15. *                                                                    *
  16. * e   ITYP    type de la liaison.                                    *
  17. * es  FTOTB   Forces extérieures totalisées sur la base B.           *
  18. * e   XPTB    Tableau des déplacements des points                    *
  19. * e   IPALB   Renseigne sur la liaison.                              *
  20. * e   IPLIB   Tableau contenant les numéros "DYNE" de la liaison.    *
  21. * e   XPALB   Tableau contenant les paramètres de la liaison.        *
  22. * es  XVALB   Tableau contenant les variables internes de liaisons.  *
  23. * es  XCHPFB  Tableau contenant les valeurs des futurs chpoints      *
  24. * e   NLIAB   Nombre de liaisons sur la base B.                      *
  25. * e   NPLB    Nombre total de points intervenant dans les liaisons.  *
  26. * e   IND     Indice du pas.                                         *
  27. * e   I       numéro de la liaison.                                  *
  28. *                                                                    *
  29. *                                                                    *
  30. *     Auteur, date de création:                                      *
  31. *                                                                    *
  32. *     Samuel DURAND      : le 18 Octobre 1996  : Création            *
  33. *                                                                    *
  34. *--------------------------------------------------------------------*
  35. *
  36.       INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
  37.       REAL*8  XPALB(NLIAB,*),XPTB(NPLB,2,*),FTOTB(NPLB,*)
  38.       REAL*8  XVALB(NLIAB,4,*),XCHPFB(2,NLIAB,4,*)
  39. *
  40. *  Initialisations
  41. *
  42. *
  43.         XVALB(I,IND,1) =0.D0
  44.         XVALB(I,IND,3) =0.D0
  45.         XVALB(I,IND,4) =0.D0
  46.         XVALB(I,IND,5) =0.D0
  47.         XVALB(I,IND,6) =0.D0
  48.         XVALB(I,IND,10) = 0.D0
  49.         XVALB(I,IND,11) = 0.D0
  50.         XVALB(I,IND,12) = 0.D0
  51.         IDIM = IPALB(I,3)
  52.         IF (ITYP.EQ.35) THEN
  53.            ID1 = 6
  54.         ELSE
  55.            ID1 = 7
  56.         ENDIF
  57.         NNOEES = IPALB(I,22)
  58.         NNOEMA=IPALB(I,21)
  59.         IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM
  60.         ICH = 26 + NNOEMA+NNOEES
  61.         ICG = 26 + 2*(NNOEMA+NNOEES)
  62.         DO 5 J=1,(NNOEMA+NNOEES)
  63.            IPALB(I,ICH+J) = 0
  64.            IPALB(I,ICG+J) = 0
  65.            DO 7 ID=1,IDIM
  66.               XPALB(I,IFO+ID) = 0.D0
  67.  7         CONTINUE
  68.            IFO = IFO + IDIM
  69.  5      CONTINUE
  70.         IF (IDIM.EQ.3) THEN
  71.             IDIMB=6
  72.         ELSE
  73.             IDIMB=3
  74.         ENDIF
  75.         DO 8 IP=1,NPLB
  76.               XCHPFB(1,I,IND,IP)=0.D0
  77.               XCHPFB(2,I,IND,IP)=0.D0
  78.  8      CONTINUE
  79. *******************************************************************
  80. * On s'intéresse au choc des noeuds esclaves sur le maillage maitre
  81. *******************************************************************
  82.         ILOCAL=IPALB(I,23)
  83. * Recherche des plus proches voisins
  84.         CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,ILOCAL,0)
  85. * Boucle sur tous les noeuds esclaves
  86.         DO 10 IESC=1,NNOEES
  87.            CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB,IND
  88.      &,IND2,PDTS2,I,IANNUL,IESC,0,XCHPFB)
  89.  10     CONTINUE
  90. ***************************
  91. *  Traitement symétrique
  92. ***************************
  93.         ISYM=IPALB(I,26)
  94.         IF (ISYM.EQ.0.OR.ISYM.EQ.1) THEN
  95. * On renverse les roles du maitre et de l esclave
  96.            CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,ILOCAL,1)
  97.            IF (ISYM.EQ.0) THEN
  98. * symétrie globale
  99. * boucle sur tous les noeuds maitres
  100.             DO 20 IMAI=1,NNOEMA
  101.                CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB,IND
  102.      &,IND2,PDTS2,I,IANNUL,IMAI,1,XCHPFB)
  103.  20         CONTINUE
  104.            ELSE
  105. * symétrie locale
  106. *
  107. *
  108.              IREF=1
  109.              INOE=1
  110.              ICH = 26 + NNOEES+NNOEMA
  111.              ICG = 26 + 2*(NNOEES+NNOEMA)
  112.  30          CONTINUE
  113.                 IF (IPALB(I,ICH+INOE).EQ.1) THEN
  114. * Ce noeud a précédemment été sollicité
  115.                    CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB,
  116.      &IND,IND2,PDTS2,I,IANNUL,INOE,1,XCHPFB)
  117.                    IMOINS=INOE-1
  118.  35                CONTINUE
  119.                    IF (IMOINS.NE.0.AND.IMOINS.NE.IREF) THEN
  120. * On regarde avant
  121.                       CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB,
  122.      &NLIAB,NPLB,IND,IND2,PDTS2,I,IANNUL,IMOINS,1,XCHPFB)
  123.                       IAPRES=IPALB(I,ICG+IMOINS)+IPALB(I,ICH+IMOINS)
  124.                       IF (IAPRES.GT.IPALB(I,ICH+IMOINS)) THEN
  125.                          IMOINS=IMOINS-1
  126.                          GOTO 35
  127.                       ENDIF
  128.                    ENDIF
  129.                    INOE=INOE+1
  130.  36                CONTINUE
  131. * On regarde apres
  132.                      CALL DYFORC(XPTB,XVALB,IPALB,IPLIB,XPALB,
  133.      &NLIAB,NPLB,IND,IND2,PDTS2,I,IANNUL,INOE,1,XCHPFB)
  134.                    IAPRES=IPALB(I,ICH+INOE)+IPALB(I,ICG+INOE)
  135.                      IF (IAPRES.GT.IPALB(I,ICH+INOE)) THEN
  136.                         IF (INOE.NE.NNOEMA) THEN
  137.                            INOE=INOE+1
  138.                            GOTO 36
  139.                         ENDIF
  140.                      ELSE
  141.                         IREF=INOE
  142.                         IF (INOE.NE.NNOEMA) THEN
  143.                            INOE=INOE+1
  144.                            GOTO 30
  145.                         ENDIF
  146.                      ENDIF
  147.                   ELSE
  148.                      IF (INOE.NE.NNOEMA) THEN
  149.                         INOE=INOE+1
  150.                         GOTO 30
  151.                      ENDIF
  152.                   ENDIF
  153.            ENDIF
  154. * On pondère les forces
  155.             ICH = 26 + NNOEES+NNOEMA
  156.             ICG = 26 + 2*(NNOEES+NNOEMA)
  157.             IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM
  158.             DO 21 INOE=1,(NNOEES+NNOEMA)
  159.                 IPALB(I,ICH+INOE)=IPALB(I,ICH+INOE)+IPALB(I,ICG+INOE)
  160.                 IF (IPALB(I,ICH+INOE).EQ.2) THEN
  161.                    DO 22 ID=1,IDIM
  162.                      FTOTB(IPLIB(I,INOE),ID)=FTOTB(IPLIB(I,INOE),ID)+
  163.      &XPALB(I,IFO+ID)/2.
  164.  22                CONTINUE
  165.                    XCHPFB(1,I,IND,IPLIB(I,INOE))=
  166.      &XCHPFB(1,I,IND,IPLIB(I,INOE))/2.
  167.                    XCHPFB(2,I,IND,IPLIB(I,INOE))=
  168.      &XCHPFB(2,I,IND,IPLIB(I,INOE))/2.
  169.                 ELSE
  170.                    DO 23 ID=1,IDIM
  171.                      FTOTB(IPLIB(I,INOE),ID)=FTOTB(IPLIB(I,INOE),ID)+
  172.      &XPALB(I,IFO+ID)
  173.  23                CONTINUE
  174.                 ENDIF
  175.                 IFO = IFO+IDIM
  176.  21         CONTINUE
  177.         ELSE
  178. ******************
  179. * pas  de symétrie
  180. ******************
  181.            IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM
  182.            DO 40 INOE=1,(NNOEMA+NNOEES)
  183.               DO 42 ID=1,IDIM
  184.                   FTOTB(IPLIB(I,INOE),ID)=FTOTB(IPLIB(I,INOE),ID)+
  185.      &XPALB(I,IFO+ID)
  186.  42           CONTINUE
  187.               IFO = IFO+IDIM
  188.  40        CONTINUE
  189. *
  190. *
  191.         ENDIF
  192. *
  193. *
  194.        END
  195.  
  196.  
  197.  
  198.  
  199.  

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