Télécharger la plaquette Cast3M


fr en

Télécharger rela3.eso

Retour à la liste

Numérotation des lignes : 

rela3

  1. C RELA3     SOURCE    PV090527  26/04/30    21:16:07     12529          
  2.       SUBROUTINE RELA3(IPC,IPM,LP,IROTA)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. *****************************************************************
  6. *
  7. *  relation de corps rigide en cas des coques ou des poutres
  8. *  eventuellement en combinaison avec des massifs
  9. *
  10. *  entrées
  11. *  IPC : pointeur sur le maillage (ou numero du point) ayant des
  12. *        ddl de rotation naturellement (poutres ou coques)
  13. *
  14. *  IPM : pointeur sur le maillage n'ayant pas des ddl de rotation
  15. *        naturellement (massif)
  16. *
  17. *  LP  : 0 --> IPC est un maillage
  18. *        1 --> IPC est un point
  19. *
  20. *  IROTA : 1 les rotaions de  IPC sont de ddl du problème
  21. *          0 les rotaions de  IPC ne sont pas de ddl du problème
  22. *            (on s'en sert pour traiter le cas fourier 0 et axis
  23. *             en l'absence du mot clé ROTA)
  24. *
  25. *  on écrit dans la pile la rigidité KRIGI
  26. *
  27. * I. Politopoulos  09/05/95
  28. ****************************************************************
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC CCGEOME
  33. -INC SMELEME
  34. -INC SMCOORD
  35. -INC SMRIGID
  36. -INC CCHAMP
  37.  
  38.       CHARACTER*4 MODEPL(5),MODEDU(5)
  39.       CHARACTER*4 MORODU(4),MOROTA(4)
  40.  
  41.       DATA MODEPL(1)/'UX  '/
  42.       DATA MODEPL(2)/'UY  '/
  43.       DATA MODEPL(3)/'UZ  '/
  44.       DATA MODEPL(4)/'UR  '/
  45.       DATA MODEPL(5)/'UT  '/
  46.       DATA MODEDU(1)/'FX  '/
  47.       DATA MODEDU(2)/'FY  '/
  48.       DATA MODEDU(3)/'FZ  '/
  49.       DATA MODEDU(4)/'FR  '/
  50.       DATA MODEDU(5)/'FT  '/
  51.       DATA MOROTA(1)/'RX  '/
  52.       DATA MOROTA(2)/'RY  '/
  53.       DATA MOROTA(3)/'RZ  '/
  54.       DATA MOROTA(4)/'RT  '/
  55.       DATA MORODU(1)/'MX  '/
  56.       DATA MORODU(2)/'MY  '/
  57.       DATA MORODU(3)/'MZ  '/
  58.       DATA MORODU(4)/'MT  '/
  59.  
  60.  
  61.  
  62. *  activation du maillage avec des ddl de rotation
  63. * et definition du noeud maitre
  64.  
  65.       IF (LP.EQ.0) THEN
  66.         MELEME=IPC
  67.         SEGACT MELEME
  68.         IF(ITYPEL .NE.1) CALL CHANGE(MELEME,1)
  69.         NBPOIC=NUM(/2)
  70.         IP1 = NUM(1,1)
  71. * si 1 seul point
  72.       ELSE
  73.         IP1 = IPC
  74.         NBPOIC = 1
  75.       ENDIF
  76. * activation du maillage massif
  77.       IF (IPM .NE. 0) THEN
  78.        IPT2 = IPM
  79.        SEGACT IPT2
  80.        IF(IPT2.ITYPEL .NE.1) CALL CHANGE(IPT2,1)
  81.        NBPOIM = IPT2.NUM(/2)
  82.       ELSE
  83.        NBPOIM = 0
  84.       ENDIF
  85.  
  86.       NBTOT = NBPOIC + NBPOIM
  87.  
  88. * nombre de noeuds
  89.        SEGACT MCOORD*mod
  90.        NBNO = nbpts
  91.  
  92. **  definition du noeud maitre en cas fourier 0 pour
  93. ** la relation sur UT car il ne peut pas etre sur l'axe.
  94. ** Pour ne pas mettre un critere absolu on choisit le point
  95. ** le plus lointain
  96.       IF ((IFOUR .EQ. 1) .AND. (NIFOUR.EQ.0)) THEN
  97.         XMAX = 0.D0
  98.          DO 8 I=1,NUM(/2)
  99.           IPP1 = NUM(1,I)
  100.           IREF1 = (IPP1-1)*(IDIM+1)
  101.           XI1 =  XCOOR(IREF1+1)
  102.            IF(ABS(XI1).GT.XMAX) THEN
  103.              XMAX = ABS(XI1)
  104.              NUM(1,I)=IP1
  105.              IP1 = IPP1
  106.              NUM(1,1)=IP1
  107.            ENDIF
  108.   8      CONTINUE
  109.       ENDIF
  110. * quelques dimensions pour l'initialisation du maillage des relations
  111.         NBSOUS = 0
  112.         NBREF = 0
  113.         NBNN = 3
  114. * coordonnees du point maitre
  115.          IREFP1 = (IP1-1)*(IDIM+1)
  116.          X1 =  XCOOR(IREFP1+1)
  117.          Y1 =  XCOOR(IREFP1+2)
  118.  
  119.       IF((IFOMOD.EQ.0).OR.((IFOMOD.EQ.1).AND.(NIFOUR.EQ.0)))
  120.      +  GOTO 100
  121.  
  122. c
  123. ccc  debut 3D ou (2d plan cont ou defo) ou (fourier 1)
  124. c
  125.          IF (IDIM .EQ.3) THEN
  126.             Z1 =  XCOOR(IREFP1+3)
  127. * nombre de types de matrices et nombre de relations
  128.             L1 = 3
  129.             L2 = 3
  130.             NNMAT = 6
  131.             NBRELA = (NBPOIC-1)*6 + NBPOIM*3
  132.          ENDIF
  133.          IF (IDIM.EQ.2) THEN
  134.           IF (IFOMOD.EQ.-1) THEN
  135.             L1 = 1
  136.             L2 = 2
  137.             NNMAT = 3
  138.             NBRELA = (NBPOIC-1)*3 + NBPOIM*2
  139. * fourier 1, -1. il faut imposer en plus que ur = -ut
  140.           ELSE IF (ABS(NIFOUR).EQ.1) THEN
  141.             L1 = 1
  142.             L2 = 3
  143.             NNMAT = 4
  144. * + 2 car le nombre des relations ur=-ut et entre rt et uz est
  145. * egal au nombre des points
  146.             NBRELA = (NBPOIC-1)*4 + NBPOIM*3 + 2
  147.           ENDIF
  148.          ENDIF
  149.          IF (NBPOIC .EQ.1) THEN
  150.           IF ((IFOMOD.EQ.2).OR.(IFOMOD.EQ.-1)) THEN
  151.             NNMAT = IDIM
  152.           ELSE IF (ABS(NIFOUR).EQ.1) THEN
  153.             NNMAT = 3
  154.           ENDIF
  155.          ENDIF
  156.  
  157. * on ajuste MCOORD pour les noeuds associes aux multiplicateurs
  158.        NBPTS = NBNO + NBRELA
  159.        NBNOI = NBNO
  160.        SEGADJ MCOORD
  161. * initialisation du segment mrigid
  162.       NRIGE=7
  163.       NRIGEL=NNMAT
  164.       SEGINI MRIGID
  165.       ICHOLE=0
  166.       IMGEO1=0
  167.       IMGEO2=0
  168.       ISUPEQ=0
  169.       IFORIG=IFOUR
  170.       MTYMAT='RIGIDITE'
  171.       KRIGI=MRIGID
  172. * relations sur les rotations
  173.       IND = 0
  174.       IF (NBPOIC.GT.1) THEN
  175.         NELRIG = (NBPOIC-1)
  176.         NLIGRE = 3
  177.         NLIGRP = NLIGRE
  178.         NLIGRD = NLIGRE
  179. *        SEGINI IMATRI
  180.         rigrel=0
  181.         SEGINI XMATRI
  182.         IXMATR=XMATRI
  183. *          DO 5 I=1,NELRIG
  184. *            IMATTT(I) = IXMATR
  185. *    5     CONTINUE
  186. * on remplit les valeurs RE de la matrice pour les rotations
  187.          RE(1,1,1)=  0.D0
  188.          RE(2,1,1)= 1.D0
  189.          RE(3,1,1)= -1.D0
  190.          RE(2,2,1)= 0.D0
  191.          RE(3,2,1)= 0.D0
  192.          RE(3,3,1)= 0.D0
  193. * on definit explicitement les termes symetriques car on a constaté
  194. * des petites differences aux resultats si on le fait pas
  195.          RE(1,2,1)= RE(2,1,1)
  196.          RE(1,3,1)= RE(3,1,1)
  197.          RE(2,3,1)= RE(3,2,1)
  198.          do ioup=2,nelrig
  199.            do io=1,re(/2)
  200.              do iu=1,re(/1)
  201.               re(iu,io,ioup)=re(iu,io,1)
  202.              enddo
  203.            enddo
  204.          enddo
  205.        SEGDES XMATRI
  206. *       SEGDES IMATRI
  207. * boucle sur les differents types de matrices
  208.        DO 10 IAA= 1,L1
  209.         IRIGEL(2,IAA) = 0
  210.         IRIGEL(5,IAA) = NIFOUR
  211.         IRIGEL(6,IAA) = 0
  212.         IRIGEL(7,IAA) = 0
  213.         IRIGEL(4,IAA) = xMATRI
  214.         COERIG(IAA) =1.D0
  215. * initialisation du segment melem associé aux blocages
  216.         NBELEM = NBPOIC-1
  217.         SEGINI IPT1
  218.         IRIGEL(1,IAA) = IPT1
  219.         IPT1.ITYPEL = 22
  220. * on remplit le tableau des descripteurs
  221.         SEGINI DESCR
  222.         IRIGEL(3,IAA)=DESCR
  223.         LISINC(1)='LX'
  224.         LISDUA(1)='FLX'
  225.         NOELEP(1)=1
  226.         NOELED(1)=1
  227.          IF (IDIM.EQ.3) THEN
  228.           LISINC(2)= MOROTA(IAA)
  229.           LISINC(3)= MOROTA(IAA)
  230.           LISDUA(2)= MORODU(IAA)
  231.           LISDUA(3)= MORODU(IAA)
  232.          ELSE IF (IFOMOD.EQ.-1) THEN
  233.           LISINC(2)= MOROTA(3)
  234.           LISINC(3)= MOROTA(3)
  235.           LISDUA(2)= MORODU(3)
  236.           LISDUA(3)= MORODU(3)
  237.          ELSE IF (ABS(NIFOUR).EQ.1) THEN
  238.           LISINC(2)= MOROTA(4)
  239.           LISINC(3)= MOROTA(4)
  240.           LISDUA(2)= MORODU(4)
  241.           LISDUA(3)= MORODU(4)
  242.          ENDIF
  243.         NOELEP(2)=2
  244.         NOELEP(3)=3
  245.         NOELED(2)=2
  246.         NOELED(3)=3
  247.         SEGDES DESCR
  248. *  boucle sur les points du maillage ayant des ddl de rotation
  249.          DO 20 II=1,NBELEM
  250.               IP2 = NUM(1,(II+1))
  251.               IREFP2 = (IP2-1)*(IDIM+1)
  252.               X2 =  XCOOR(IREFP2+1)
  253.               Y2 =  XCOOR(IREFP2+2)
  254.               IF (IDIM.EQ.3) Z2 =  XCOOR(IREFP2+3)
  255.               IPT1.ICOLOR(II) = IDCOUL
  256. * points associés aux multiplicateurs
  257.               IPT1.NUM(1,II) = NBNOI + 1
  258.               IREFM1 = NBNOI*(IDIM+1)
  259.               NBNOI = NBNOI + 1
  260.               IPT1.NUM(2,II) = IP1
  261.               IPT1.NUM(3,II) = IP2
  262.               XCOOR(IREFM1+1) = (X1 + X2)/2
  263.               XCOOR(IREFM1+2) = (Y1 + Y2)/2
  264.                IF (IDIM.EQ.3) THEN
  265.                 XCOOR(IREFM1+3) = (Z1 + Z2)/2
  266.                ENDIF
  267.  20     CONTINUE
  268.         SEGDES IPT1
  269.        IND = IAA
  270.  10    CONTINUE
  271.       ENDIF
  272.  
  273. *  fin de relations sur les rotations on passe
  274. * aux relations entre le noeud maitre et les depl. des autres noeuds
  275.        IF (IDIM.EQ.3) NLIGRE = 5
  276.        IF (IDIM.EQ.2) NLIGRE = 4
  277.        NLIGRP = NLIGRE
  278.        NLIGRD = NLIGRE
  279.        NELRIG = (NBTOT-1)
  280.        NBELEM = NBTOT-1
  281. * boucle sur les differents types de matrices
  282.       DO 40 IAAA= 1,L2
  283.         IAA = IND + IAAA
  284. * relations entre rt et uz et ur = -ut en fourier 1
  285.        IF((ABS(NIFOUR).EQ.1).AND.(IAAA.gt.1)) then
  286.          nligre = 3
  287.          nligrp = nligre
  288.          nligrd = nligre
  289.          NELRIG = NBTOT
  290.          NBELEM = NBTOT
  291.        ENDIF
  292. * initialisation du segment melem associé aux blocages
  293.         SEGINI IPT1
  294.         IPT1.ITYPEL = 22
  295. *
  296.         IRIGEL(1,IAA) = IPT1
  297.         IRIGEL(2,IAA) = 0
  298.         IRIGEL(5,IAA) = NIFOUR
  299.         IRIGEL(6,IAA) = 0
  300.         IRIGEL(7,IAA) = 0
  301.         rigrel=0
  302.         SEGINI xMATRI
  303.         IRIGEL(4,IAA) = xMATRI
  304.         COERIG(IAA) =1.D0
  305. * on remplit le tableau des descripteurs
  306.         SEGINI DESCR
  307.         IRIGEL(3,IAA)=DESCR
  308.         LISINC(1)='LX'
  309.         LISDUA(1)='FLX'
  310.         NOELEP(1)=1
  311.         NOELED(1)=1
  312.  
  313.         NOELEP(2)=3
  314.         NOELEP(3)=2
  315.         NOELED(2)=3
  316.         NOELED(3)=2
  317.        IF (.NOT.((ABS(NIFOUR).EQ.1).AND.(IAAA.gt.1)))THEN
  318.         NOELEP(4)=2
  319.         NOELED(4)=2
  320.        endif
  321.         IF ((ABS(NIFOUR).EQ.1).and.(iaaa.eq.1)) kk = 4
  322.         IF ((IFOMOD.EQ.2).OR.(IFOMOD.EQ.-1)) KK = IAAA
  323.         LISINC(2)= MODEPL(KK)
  324.         LISINC(3)= MODEPL(KK)
  325.         LISDUA(2)= MODEDU(KK)
  326.         LISDUA(3)= MODEDU(KK)
  327. * relation entre rt et uz en fourier 1
  328.         IF ((ABS(NIFOUR).EQ.1).and.(iaaa.eq.2)) then
  329.         LISINC(2)= MODEPL(3)
  330.         LISINC(3)= MOROTA(4)
  331.         LISDUA(2)= MODEDU(3)
  332.         LISDUA(3)= MORODU(4)
  333.         endif
  334. * relation entre ur et ut en fourier 1
  335.        if ((ABS(NIFOUR).EQ.1).AND.(IAAA.eq.3)) then
  336.         LISINC(2)= MODEPL(4)
  337.         LISINC(3)= MODEPL(5)
  338.         LISDUA(2)= MODEDU(4)
  339.         LISDUA(3)= MODEDU(5)
  340.        ENDIF
  341.  
  342.         IF (IDIM.EQ.3) THEN
  343.          IF (IAAA.EQ.1) THEN
  344.            LISINC(4)= MOROTA(2)
  345.            LISINC(5)= MOROTA(3)
  346.            LISDUA(4)= MORODU(2)
  347.            LISDUA(5)= MORODU(3)
  348.          ELSE IF (IAAA.EQ.2) THEN
  349.            LISINC(4)= MOROTA(3)
  350.            LISINC(5)= MOROTA(1)
  351.            LISDUA(4)= MORODU(3)
  352.            LISDUA(5)= MORODU(1)
  353.          ELSE
  354.            LISINC(4)= MOROTA(1)
  355.            LISINC(5)= MOROTA(2)
  356.            LISDUA(4)= MORODU(1)
  357.            LISDUA(5)= MORODU(2)
  358.          ENDIF
  359.         NOELEP(5)=2
  360.         NOELED(5)=2
  361. * cont. ou defo planes
  362.        ELSE IF (IFOMOD.EQ.-1) THEN
  363.         LISINC(4)= MOROTA(3)
  364.         LISDUA(4)= MORODU(3)
  365. * fourier 1 ou -1
  366.        ELSE IF ((ABS(NIFOUR).EQ.1).AND.(IAAA.eq.1)) THEN
  367.         LISINC(4)= MOROTA(4)
  368.         LISDUA(4)= MORODU(4)
  369.        ENDIF
  370.  
  371.        SEGDES DESCR
  372.  
  373. *  boucle sur les points du maillage total
  374.           DO 50 II=1,NBELEM
  375.            IF(NBELEM.NE.NBTOT) THEN
  376. * partie coques ou poutres
  377.             IF (II.LT.NBPOIC) IP2 = NUM(1,(II+1))
  378. * partie massif
  379.             IF (II.GE.NBPOIC) IP2 = IPT2.NUM(1,(II-NBPOIC+1))
  380.            ELSE
  381. * fourier 1 ou -1, relation ur = -ut et relation entre rt et uz
  382.             IF (II.LE.NBPOIC) IP2 = NUM(1,II)
  383.             IF (II.GT.NBPOIC) IP2 = IPT2.NUM(1,(II-NBPOIC))
  384.            ENDIF
  385.             IREFP2 = (IP2-1)*(IDIM+1)
  386.             X2 =  XCOOR(IREFP2+1)
  387.             Y2 =  XCOOR(IREFP2+2)
  388.             IF (IDIM.EQ.3) Z2 =  XCOOR(IREFP2+3)
  389.             IPT1.ICOLOR(II) = IDCOUL
  390. * points associés aux multiplicateurs
  391.             IPT1.NUM(1,II) = NBNOI + 1
  392.             IREFM1 = NBNOI*(IDIM+1)
  393.             NBNOI = NBNOI + 1
  394.               IF((ABS(NIFOUR).EQ.1).AND.(IAAA.EQ.3)) THEN
  395.                 IP1 = IP2
  396.                 X1 = X2
  397.                 Y1 = Y2
  398.               ENDIF
  399.             IPT1.NUM(2,II) = IP1
  400.             IPT1.NUM(3,II) = IP2
  401.             XCOOR(IREFM1+1) = (X1 + X2)/2
  402.             XCOOR(IREFM1+2) = (Y1 + Y2)/2
  403.               IF (IDIM.EQ.3) THEN
  404.                 XCOOR(IREFM1+3) = (Z1 + Z2)/2
  405.               ENDIF
  406. * on remplit les valeurs RE de la matrice
  407. *            SEGINI XMATRI
  408. *            IXMATR = XMATRI
  409. *            IMATTT(II) = IXMATR
  410.  
  411.             IF (IAAA.EQ.1) THEN
  412.               COEF1 = Z2-Z1
  413.               COEF2 = Y2-Y1
  414.             ELSE IF (IAAA.EQ.2) THEN
  415.               COEF1 = X2-X1
  416.               COEF2 = Z2-Z1
  417.             ELSE
  418.               COEF1 = Y2-Y1
  419.               COEF2 = X2-X1
  420.             ENDIF
  421.  
  422.             RE(1,1,ii)=  0.D0
  423.             RE(2,1,ii)= 1.D0
  424.             RE(3,1,ii)= -1.D0
  425.        if (abs(nifour).eq.1) then
  426. * relation entre uz et rt en fourier 1
  427.           if (iaaa.eq.2) then
  428.             re(3,1,ii) = -x2
  429.           endif
  430. * relation ur = -ut en fourier 1
  431.           if (iaaa.eq.3) then
  432.             RE(3,1,ii)= 1.D0
  433.           endif
  434.        ENDIF
  435.           IF (IDIM.EQ.3) THEN
  436.             RE(4,1,ii)= -1.D0*COEF1
  437.             RE(5,1,ii)=  1.D0*COEF2
  438.           ELSE IF (IFOMOD.EQ.-1) THEN
  439.            IF (IAAA.EQ.1) THEN
  440.              RE(4,1,ii)= 1.D0*COEF2
  441.            ELSE
  442.              RE(4,1,ii)= -1.D0*COEF1
  443.            ENDIF
  444.           ELSE  IF ((ABS(NIFOUR).EQ.1).and.(iaaa.eq.1)) then
  445. * relation entre ur1, ur2 et rt1 en fourier 1
  446. *  le signe ne respecte pas le triedre orthonorme de fourier mais
  447. *  celui des calculs plans. Ce n'est pas tres elegant mais c'est
  448. *  comme ca dans C2000 !!!!
  449.              RE(4,1,ii)= 1.D0*COEF2
  450.           ENDIF
  451.  
  452.               DO 7 I=1,1
  453.                 DO 6 J=2,NLIGRE
  454.                   RE(I,J,ii)=RE(J,I,ii)
  455.   6             CONTINUE
  456.   7           CONTINUE
  457.  
  458.               DO 3 I=2,NLIGRE
  459.                 DO 4 J=2,NLIGRE
  460.                   RE(I,J,ii)=0.D0
  461.   4             CONTINUE
  462.   3           CONTINUE
  463.  
  464. *           SEGDES XMATRI
  465.  50       CONTINUE
  466.        SEGDES xMATRI
  467.        SEGDES IPT1
  468.  40   CONTINUE
  469.       GOTO 1000
  470.  
  471. *
  472. *** fin 3D ou (2d plan cont ou defo) ou (fourier 1)
  473. *
  474.  
  475.  100   CONTINUE
  476. *
  477. *** fourier 0 ou axis
  478. *
  479.       NBNN = 2
  480.  
  481.       IF (IFOMOD.EQ.0) THEN
  482. * axis : UR=0  RT=0  UZ = cte
  483.         L2 = 2
  484.         NNMAT = 3
  485.         NBRELA = NBPOIC*3 + NBPOIM*2 - 1
  486. * cas sans rotation
  487.          if (irota.eq.0) then
  488.            nnmat = 2
  489.            nbrela = nbpoic*2 -1
  490.          endif
  491.       ELSE
  492. * fourier 0 : UR=0  RT=0  UZ = cte  relation d'analogie sur UT
  493.         L2 = 3
  494.         NNMAT = 4
  495.         NBRELA = NBPOIC*4 + NBPOIM*3 - 2
  496. * cas sans rotation
  497.          if (irota.eq.0) then
  498.            nnmat = 3
  499.            nbrela = nbpoic*3 -2
  500.          endif
  501.       ENDIF
  502. * on ajuste MCOORD pour les noeuds associes aux multiplicateurs
  503.        NBPTS = NBNO + NBRELA
  504.        NBNOI = NBNO
  505.        SEGADJ MCOORD
  506. * initialisation du segment mrigid
  507.       NRIGE=7
  508.       NRIGEL=NNMAT
  509.       SEGINI MRIGID
  510.       ICHOLE=0
  511.       IMGEO1=0
  512.       IMGEO2=0
  513.       ISUPEQ=0
  514.       IFORIG=IFOUR
  515.       MTYMAT='RIGIDITE'
  516.       KRIGI=MRIGID
  517.        if (irota.eq.0) goto 121
  518. *  rotation RT = 0
  519.       NELRIG = NBPOIC
  520.         NLIGRE = 2
  521.         NLIGRP = NLIGRE
  522.         NLIGRD = NLIGRE
  523. *        SEGINI IMATRI
  524.         rigrel=0
  525.         SEGINI XMATRI
  526. *        IXMATR=XMATRI
  527. *          DO 105 I=1,NELRIG
  528. *            IMATTT(I) = IXMATR
  529. *  105     CONTINUE
  530. * on remplit les valeurs RE de la matrice pour les rotations
  531.          RE(1,1,1)=  0.D0
  532.          RE(2,1,1)= 1.D0
  533.          RE(2,2,1)= 0.D0
  534.          RE(1,2,1)= RE(2,1,1)
  535.          do ioup=2,nelrig
  536.            do io=1,re(/2)
  537.              do iu=1,re(/1)
  538.                 re(iu,io,ioup)=re(iu,io,1)
  539.               enddo
  540.            enddo
  541.          enddo
  542. *       SEGDES XMATRI
  543.        SEGDES xMATRI
  544.  
  545.         IRIGEL(2,1) = 0
  546.         IRIGEL(5,1) = NIFOUR
  547.         IRIGEL(6,1) = 0
  548.         IRIGEL(7,1) = 0
  549.         IRIGEL(4,1) = xMATRI
  550.         COERIG(1) =1.D0
  551. * initialisation du segment melem associé aux blocages
  552.         NBELEM = NBPOIC
  553.         SEGINI IPT1
  554.         IRIGEL(1,1) = IPT1
  555.         IPT1.ITYPEL = 22
  556. * on remplit le tableau des descripteurs
  557.         SEGINI DESCR
  558.         IRIGEL(3,1)=DESCR
  559.         LISINC(1)='LX'
  560.         LISDUA(1)='FLX'
  561.         LISINC(2)= MOROTA(4)
  562.         LISDUA(2)= MORODU(4)
  563.         NOELEP(1)=1
  564.         NOELED(1)=1
  565.         NOELEP(2)=2
  566.         NOELED(2)=2
  567.         SEGDES DESCR
  568. *  boucle sur les points du maillage ayant des ddl de rotation
  569.          DO 120 II=1,NBELEM
  570.             IP2 = NUM(1,II)
  571.             IREFP2 = (IP2-1)*(IDIM+1)
  572.             X2 =  XCOOR(IREFP2+1)
  573.             Y2 =  XCOOR(IREFP2+2)
  574.             IPT1.ICOLOR(II) = IDCOUL
  575. * points associés aux multiplicateurs
  576.             IPT1.NUM(1,II) = NBNOI + 1
  577.             IREFM1 = NBNOI*(IDIM+1)
  578.             NBNOI = NBNOI + 1
  579.             IPT1.NUM(2,II) = IP2
  580.             XCOOR(IREFM1+1) = X2
  581.             XCOOR(IREFM1+2) = Y2
  582.  120    CONTINUE
  583.       SEGDES IPT1
  584.  121   continue
  585.  
  586. *  fin de relations sur la rotation on passe aux relations
  587. *  sur les déplacements
  588.       DO 140 IAAA= 1,L2
  589.        IAA = 1 + IAAA
  590.        if (irota.eq.0) iaa = iaaa
  591.         IF (IAAA.EQ.1) THEN
  592.           NLIGRE = 2
  593.           NBELEM = NBTOT
  594.         ELSE
  595.           NLIGRE =3
  596.           NBELEM = NBTOT-1
  597.           NBNN = 3
  598.         ENDIF
  599.        NLIGRP = NLIGRE
  600.        NLIGRD = NLIGRE
  601.        NELRIG = NBELEM
  602. * initialisation du segment melem associé aux blocages
  603.         SEGINI IPT1
  604.         IPT1.ITYPEL = 22
  605.         IRIGEL(1,IAA) = IPT1
  606.         IRIGEL(2,IAA) = 0
  607.         IRIGEL(5,IAA) = NIFOUR
  608.         IRIGEL(6,IAA) = 0
  609.         IRIGEL(7,IAA) = 0
  610.         rigrel=0
  611.         SEGINI xMATRI
  612.  
  613.  
  614.         IRIGEL(4,IAA) = xMATRI
  615.         COERIG(IAA) =1.D0
  616. * on remplit le tableau des descripteurs
  617.         SEGINI DESCR
  618.         IRIGEL(3,IAA)=DESCR
  619.         LISINC(1)='LX'
  620.         LISDUA(1)='FLX'
  621.         NOELEP(1)=1
  622.         NOELED(1)=1
  623.         NOELEP(2)=2
  624.         NOELED(2)=2
  625.          IF(IAAA.EQ.1) THEN
  626.           LISINC(2) = MODEPL(4)
  627.           LISDUA(2) = MODEDU(4)
  628.          ELSE
  629.           NOELEP(3)=4
  630.           NOELED(3)=4
  631.            IF(IAAA.EQ.2) THEN
  632.             LISINC(2) = MODEPL(3)
  633.             LISDUA(2) = MODEDU(3)
  634.             LISINC(3) = MODEPL(3)
  635.             LISDUA(3) = MODEDU(3)
  636.            ELSE
  637.             LISINC(2) = MODEPL(5)
  638.             LISDUA(2) = MODEDU(5)
  639.             LISINC(3) = MODEPL(5)
  640.             LISDUA(3) = MODEDU(5)
  641.            ENDIF
  642.          ENDIF
  643.         SEGDES DESCR
  644.           DO 150 II=1,NBELEM
  645.            IF(IAAA.GT.1) THEN
  646.             IF (II.LT.NBPOIC) IP2 = NUM(1,(II+1))
  647.             IF (II.GE.NBPOIC) IP2 = IPT2.NUM(1,(II-NBPOIC+1))
  648.            ELSE
  649.             IF (II.LE.NBPOIC) IP2 = NUM(1,II)
  650.             IF (II.GT.NBPOIC) IP2 = IPT2.NUM(1,(II-NBPOIC))
  651.            ENDIF
  652.             IREFP2 = (IP2-1)*(IDIM+1)
  653.             X2 =  XCOOR(IREFP2+1)
  654.             Y2 =  XCOOR(IREFP2+2)
  655.             IPT1.ICOLOR(II) = IDCOUL
  656. * points associés aux multiplicateurs
  657.             IPT1.NUM(1,II) = NBNOI + 1
  658.             IREFM1 = NBNOI*(IDIM+1)
  659.             NBNOI = NBNOI + 1
  660.             IPT1.NUM(3,II) = IP2
  661.              IF(IAAA.GT.1) THEN
  662.               IPT1.NUM(4,II) = IP1
  663.               XCOOR(IREFM1+1) = (X1 + X2)/2
  664.               XCOOR(IREFM1+2) = (Y1 + Y2)/2
  665.              ELSE
  666.               XCOOR(IREFM1+1) = X2
  667.               XCOOR(IREFM1+2) = Y2
  668.              ENDIF
  669.  
  670. * on remplit les valeurs RE de la matrice
  671.  
  672. *             SEGINI XMATRI
  673. *             IXMATR = XMATRI
  674.            IF(IAAA.EQ.1) THEN
  675.              RE(1,1,ii)= 0.D0
  676.              RE(2,1,ii)= 1.D0
  677.              RE(2,2,ii)= 0.D0
  678.              RE(1,2,ii)= RE(2,1,ii)
  679.              RE(1,2,ii)= RE(3,1,ii)
  680.             ELSE
  681.               RE(1,1,ii)=  0.D0
  682.               RE(2,1,ii)= 1.D0
  683.                IF (IAAA.EQ.2) THEN
  684.                 RE(3,1,ii)= -1.D0
  685.                ELSE
  686.                 COEF1 = X2/X1
  687.                 RE(3,1,ii)= -1.D0*COEF1
  688.                ENDIF
  689.               RE(2,2,ii)= 0.D0
  690.               RE(3,2,ii)= 0.D0
  691.               RE(3,3,ii)= 0.D0
  692.               RE(1,2,ii)= RE(2,1,ii)
  693.               RE(1,3,ii)= RE(3,1,ii)
  694.               RE(2,3,ii)= RE(3,2,ii)
  695.             ENDIF
  696.  
  697. *            SEGDES XMATRI
  698. *            IMATTT(II) = IXMATR
  699.  150      CONTINUE
  700.        SEGDES xMATRI
  701.        SEGDES IPT1
  702.  140  CONTINUE
  703.  
  704.  1000 CONTINUE
  705.       SEGDES MRIGID
  706.       CALL ECROBJ('RIGIDITE', KRIGI)
  707.       IF (LP.EQ.0) SEGDES MELEME
  708.       IF (IPM.NE.0) SEGDES IPT2
  709.       RETURN
  710.       END
  711.  
  712.  
  713.  
  714.  
  715.  
  716.  
  717.  
  718.  
  719.  
  720.  

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