Télécharger la plaquette Cast3M


fr en

Télécharger dyn207.eso

Retour à la liste

Numérotation des lignes : 

dyn207

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

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