Télécharger la plaquette Cast3M


fr en

Télécharger dyn206.eso

Retour à la liste

Numérotation des lignes : 

dyn206

  1. C DYN206    SOURCE    CB215821  20/11/25    13:26:15     10792          
  2.       SUBROUTINE DYN206(I,ITLB,ITYP,KTLIAB,NPLB)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. *                                                                    *
  7. *     Opérateur DYNE : algorithme de Fu - de Vogelaere               *
  8. *     ________________________________________________               *
  9. *                                                                    *
  10. *     Remplissage des tableaux de description des liaisons sur       *
  11. *     la base des informations contenues dans la table ILIB          *
  12. *     Liaison de type LIGNE_LIGNE_FROTTEMENT                         *
  13. *                                                                    *
  14. *     Paramètres:                                                    *
  15. *                                                                    *
  16. * e   I       Numéro de la liaison.                                  *
  17. * e   ITLB    Table rassemblant la description d'une liaison.        *
  18. * e   ITYP    Type de la liaison.                                    *
  19. *  s  KTLIAB  Segment descriptif des liaisons sur base B.            *
  20. * e   NPLB    Nombre total de points.                                *
  21. *                                                                    *
  22. *                                                                    *
  23. *     Auteur, date de création:                                      *
  24. *                                                                    *
  25. *     Samuel DURAND, le 18 Octobre 1996.                             *
  26. *                                                                    *
  27. *--------------------------------------------------------------------*
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC SMCOORD
  32. -INC SMELEME
  33. -INC SMCHPOI
  34. *
  35.       SEGMENT MTLIAB
  36.          INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  37.          REAL*8 XPALB(NLIAB,NXPALB)
  38.          REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  39.       ENDSEGMENT
  40. *
  41.       SEGMENT MLIGNE
  42.          INTEGER KPLIB(NPLB)
  43.       ENDSEGMENT
  44. *
  45.       LOGICAL L1,L0
  46.       CHARACTER*8 MONAMO,MONESC,MONREC,MONJEU,CMOT,CMOT1,MONSYM,CHARRE
  47. *
  48.       MTLIAB = KTLIAB
  49.       SEGINI MLIGNE
  50. *
  51. * --- choc élémentaire LIGNE_LIGNE_FROTTEMENT
  52. *            avec ou sans amortissement
  53. *
  54.          CALL ACCTAB(ITLB,'MOT',I0,X0,'LIGNE_MAITRE',L0,IP0,
  55.      &                    'MAILLAGE',I1,X1,CHARRE,L1,IMAI)
  56.          IF (IERR.NE.0) RETURN
  57.          MONESC = ' '
  58.          CALL ACCTAB(ITLB,'MOT',I0,X0,'LIGNE_ESCLAVE',L0,IP0,
  59.      &                    MONESC,I1,X1,CHARRE,L1,IESC)
  60.          IF (IERR.NE.0) RETURN
  61.          CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEURS',L0,IP0,
  62.      &                    'CHPOINT',I0,X1,CHARRE,L1,IRAIES)
  63.          IF (IERR.NE.0) RETURN
  64.          CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_GLISSEMENT',L0,IP0,
  65.      &                    'FLOTTANT',I0,XGLIS,CHARRE,L1,IP1)
  66.          IF (IERR.NE.0) RETURN
  67.          CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_ADHERENCE',L0,IP0,
  68.      &                    'FLOTTANT',I0,XADHE,CHARRE,L1,IP1)
  69.          IF (IERR.NE.0) RETURN
  70.          CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR_TANGENTIELLE',L0,IP0,
  71.      &                    'FLOTTANT',I0,XRAIT,CHARRE,L1,IP1)
  72.          IF (IERR.NE.0) RETURN
  73.          CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT_TANGENTIEL',L0,
  74.      &                    IP0,'FLOTTANT',I0,XAMOT,CHARRE,L1,IP1)
  75.          IF (IERR.NE.0) RETURN
  76. *
  77.          MONAMO = ' '
  78.          CALL ACCTAB(ITLB,'MOT',I0,X0,'AMORTISSEMENTS',L0,IP0,
  79.      &                    MONAMO,I1,X1,CHARRE,L1,IAMOES)
  80.          IF (IERR.NE.0) RETURN
  81. *
  82.          MONREC = ' '
  83.          CALL ACCTAB(ITLB,'MOT',I0,X0,'RECHERCHE',L0,IP0,
  84.      &                    MONREC,I1,X1,CMOT,L1,IP1)
  85.          IF (IERR.NE.0) RETURN
  86. *
  87.          MONJEU = ' '
  88.          CALL ACCTAB(ITLB,'MOT',I1,X0,'JEU',L0,IP0,
  89.      &                    MONJEU,I0,XJEU,CHARRE,L1,IP1)
  90.          IF (IERR.NE.0) RETURN
  91. *
  92. *bp,2016 petit message informatif pour ceux qui, comme moi, n'auraient 
  93. *        pas lu la notice jusqu'au bout :
  94.          IF(XRAIT.LT.0.D0) THEN
  95.            IF(XAMOT.LE.0D0.OR.IIMPI.GT.0) THEN
  96.            WRITE(IOIMP,*) 'Liaison elementaire ..._FROTTEMENT numero',I
  97.            WRITE(IOIMP,*) 
  98.      &      'utilisation du modele de frottement regularise d ODEN'
  99.            ENDIF
  100.            IF(XAMOT.LE.0D0) THEN
  101. c             ERREUR:  %m1:8 = %r1 inferieur a %r2
  102.               MOTERR(1:8)='AMOR*_T*'
  103.               REAERR(1)=XAMOT
  104.               REAERR(2)=0.D0
  105.               CALL ERREUR(41)
  106.               RETURN
  107.            ENDIF
  108.          ENDIF
  109.  
  110.          IPALB(I,1) = ITYP
  111.          IPALB(I,3) = IDIM
  112.          XPALB(I,3) = XGLIS
  113.          XPALB(I,4) = XADHE
  114.          XPALB(I,5) = XRAIT
  115.          XPALB(I,6) = XAMOT
  116. *
  117.          IF (MONAMO.EQ.'CHPOINT') THEN
  118.             IPALB(I,1) = 36
  119.             ID1 = 7
  120.          ELSE
  121.             ID1 = 6
  122.          ENDIF
  123. *   Normale au plan
  124.          IF (IDIM.EQ.3) THEN
  125.             CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  126.      &                    'POINT',I1,X1,CHARRE,L1,INOR)
  127.             IF (IERR.NE.0) RETURN
  128.             IPNO  = (IDIM + 1) * (INOR - 1)
  129.             PS = 0.D0
  130.             DO 80 ID = 1,IDIM
  131.                XC = XCOOR(IPNO + ID)
  132.                PS = PS + XC * XC
  133.  80         CONTINUE
  134. *        end do
  135.             IF (PS.LE.0.D0) THEN
  136.                CALL ERREUR(162)
  137.                RETURN
  138.             ENDIF
  139.             DO 81 ID=1,IDIM
  140.                XPALB(I,ID1+ID) = XCOOR(IPNO + ID) / SQRT(PS)
  141.  81         CONTINUE
  142.          ELSE
  143.             DO 82 ID=1,IDIM
  144.                XPALB(I,ID1+ID) = 0.D0
  145.  82         CONTINUE
  146.          ENDIF
  147.          IF (MONJEU.EQ.'FLOTTANT') THEN
  148.             XPALB(I,2) = XJEU
  149.          ELSE
  150.             XPALB(I,2) = 0.D0
  151.          ENDIF
  152. *   La recherche s'effectue par défaut localement
  153.          IF (MONREC.EQ.'MOT') THEN
  154.             IF (CMOT(1:7).EQ.'GLOBALE') THEN
  155.                 IPALB(I,23) = 1
  156.             ELSE
  157.                 IPALB(I,23) = 0
  158.             ENDIF
  159.          ELSE
  160.             IPALB(I,23) = 0
  161.          ENDIF
  162. *
  163. *   Coordonnées du maillage_maitre
  164.          MELEME = IMAI
  165.          SEGACT MELEME
  166. *   Pour savoir si le contour est fermé
  167.          NELEMA = NUM(/2)
  168.          IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN
  169.             NNOEMA = NELEMA
  170.             IFERMA = 1
  171.          ELSE
  172.             NNOEMA = NELEMA +1
  173.             IFERMA = 0
  174.          ENDIF
  175.          IPALB(I,21) = NNOEMA
  176.          IPALB(I,24) = IFERMA
  177.          ID2 = ID1 + 4*IDIM
  178.          IPT = NUM(1,1)
  179.          INPT = (IDIM+1)*(IPT-1)
  180.          CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  181.          IPLIB(I,1) = IPLAC
  182.          KPLIB(1) = IPT
  183.          DO 84 ID=1,IDIM
  184.             XPALB(I,ID2+ID) = XCOOR(INPT+ID)
  185.  84         CONTINUE
  186.          DO 85 IE=1,(NNOEMA-1)
  187.             IPT = NUM(2,IE)
  188.             INPT = (IDIM+1)*(IPT-1)
  189.             CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  190.             IPLIB(I,IE+1) = IPLAC
  191.             KPLIB(IE+1) = IPT
  192.             IDIE = ID2 + IE*IDIM
  193.             DO 86 ID=1,IDIM
  194.                 XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  195.  86             CONTINUE
  196.  85         CONTINUE
  197.          SEGDES MELEME
  198. *
  199. *   Maillage_esclave
  200.          ID3 = ID2 + NNOEMA*IDIM
  201.          IF (MONESC.EQ.'POINT') THEN
  202. * La ligne esclave est un point
  203.             NNOEES=1
  204.             IFERES=0
  205.             ISYMET=-1
  206. * Lecture des coordonnées
  207.             IPESC = (IDIM+1)*(IESC-1)
  208.             CALL PLACE2(JPLIB,NPLB,IPLAC,IESC)
  209.             IPLIB(I,NNOEMA+1)  = IPLAC
  210.             KPLIB(NNOEMA+1) = IESC
  211.             DO 90 ID = 1,IDIM
  212.                XPALB(I,ID3+ID) = XCOOR(IPESC+ID)
  213.  90         CONTINUE
  214. *
  215.             IPALB(I,22) = NNOEES
  216.             IPALB(I,25) = IFERES
  217.             IPALB(I,26) = ISYMET
  218.          ELSE
  219.          IF (MONESC.EQ.'MAILLAGE') THEN
  220. *    La ligne esclave est un maillage
  221.             MELEME = IESC
  222.             SEGACT MELEME
  223. *   Pour savoir si le contour est fermé
  224.             NELEES = NUM(/2)
  225.             IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN
  226.                NNOEES = NELEES
  227.                IFERES = 1
  228.             ELSE
  229.                NNOEES = NELEES +1
  230.                IFERES = 0
  231.             ENDIF
  232.             IPALB(I,22) = NNOEES
  233.             IPALB(I,25) = IFERES
  234. *   Coordonnées du maillage_esclave
  235.             IPT = NUM(1,1)
  236.             INPT = (IDIM+1)*(IPT-1)
  237.             CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  238.             IPLIB(I,NNOEMA+1) = IPLAC
  239.             KPLIB(NNOEMA+1) = IPT
  240.             DO 94 ID=1,IDIM
  241.                XPALB(I,ID3+ID) = XCOOR(INPT+ID)
  242.  94         CONTINUE
  243.             DO 95 IE=1,(NNOEES-1)
  244.                IPT = NUM(2,IE)
  245.                INPT = (IDIM+1)*(IPT-1)
  246.                CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  247.                IPLIB(I,NNOEMA+IE+1) = IPLAC
  248.                KPLIB(NNOEMA+IE+1) = IPT
  249.                IDIE = ID3 + IE*IDIM
  250.                DO 96 ID=1,IDIM
  251.                   XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  252.  96            CONTINUE
  253.  95         CONTINUE
  254.             SEGDES MELEME
  255.             MONSYM=' '
  256.             CALL ACCTAB(ITLB,'MOT',I0,X0,'SYMETRIE',L0,IP0,
  257.      &                    MONSYM,I1,X1,CMOT1,L1,IP1)
  258. *   Le traitement symétrique par défaut ne s'effectue pas
  259.             IF (MONSYM.EQ.'MOT') THEN
  260.                IF (CMOT1(1:7).EQ.'LOCALE') THEN
  261.                   IPALB(I,26) = 1
  262.                ELSE
  263.                   IF (CMOT1(1:4).EQ.'VRAI'.OR.
  264.      &CMOT1(1:7).EQ.'GLOBALE') THEN
  265.                      IPALB(I,26) = 0
  266.                   ELSE
  267.                      IPALB(I,26) = -1
  268.                   ENDIF
  269.                ENDIF
  270.             ELSE
  271.                IPALB(I,26) = -1
  272.             ENDIF
  273.          ELSE
  274. * La ligne esclave n'est ni un point ni un maillage
  275. *           CALL ERREUR(...)
  276.             RETURN
  277.          ENDIF
  278.          ENDIF
  279. * Lecture des chpoints de raideur et d amortissement
  280. * Raideurs des noeuds esclaves  et maitres
  281.          ID4=ID1+(2*(NNOEMA+NNOEES)+4)*IDIM
  282.          MCHPOI=IRAIES
  283.          SEGACT,MCHPOI
  284.          NSOUP=IPCHP(/1)
  285.          DO 100 IPC=1,NSOUP
  286.              MSOUPO=IPCHP(IPC)
  287.              SEGACT,MSOUPO
  288.              MELEME = IGEOC
  289.              SEGACT,MELEME
  290.              MPOVAL = IPOVAL
  291.              SEGACT,MPOVAL
  292.              NNN = NUM(/2)
  293.              DO 110 INN=1,NNN
  294.                IPT = NUM(1,INN)
  295.                CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  296.                IF (IPLAC.NE.0) THEN
  297.                   XPALB(I,ID4+IPLAC)=VPOCHA(INN,1)
  298.                ENDIF
  299.  110         CONTINUE
  300.              SEGDES,MPOVAL,MELEME
  301.              SEGDES MSOUPO
  302.  100     CONTINUE
  303.          SEGDES,MCHPOI
  304. *  Amortissement des noeuds esclaves et maitres
  305.          ID5=ID4+NNOEMA+NNOEES
  306.          IF (IPALB(I,1).EQ.36) THEN
  307.               MCHPOI=IAMOES
  308.               SEGACT,MCHPOI
  309.               NSOUP = IPCHP(/1)
  310.               DO 120 IPC=1,NSOUP
  311.                  MSOUPO=IPCHP(IPC)
  312.                  SEGACT,MSOUPO
  313.                  MELEME = IGEOC
  314.                  SEGACT,MELEME
  315.                  MPOVAL = IPOVAL
  316.                  SEGACT,MPOVAL
  317.                  NNN=NUM(/2)
  318.                  DO 130 INN=1,NNN
  319.                     IPT = NUM(1,INN)
  320.                     CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  321.                     IF (IPLAC.NE.0) THEN
  322.                         XPALB(I,ID5+IPLAC)=VPOCHA(INN,1)
  323.                     ENDIF
  324.  130             CONTINUE
  325.                  SEGDES MPOVAL,MELEME
  326.                  SEGDES MSOUPO
  327.  120           CONTINUE
  328.                SEGDES MCHPOI
  329.          ENDIF
  330.          SEGSUP MLIGNE
  331. *        end do
  332. *
  333. *
  334. * --- choc élémentaire ..._PLAN...
  335. *
  336. *     ELSE IF (ITYP.EQ.  ) THEN
  337. *        ...
  338. *        ...
  339. *
  340.       END
  341.  
  342.  
  343.  
  344.  
  345.  
  346.  
  347.  

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