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    FANDEUR   22/01/03    21:15:40     11237          
  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.         SEGINI XMATRI
  181.         IXMATR=XMATRI
  182. *          DO 5 I=1,NELRIG
  183. *            IMATTT(I) = IXMATR
  184. *    5     CONTINUE
  185. * on remplit les valeurs RE de la matrice pour les rotations
  186.          RE(1,1,1)=  0.D0
  187.          RE(2,1,1)= 1.D0
  188.          RE(3,1,1)= -1.D0
  189.          RE(2,2,1)= 0.D0
  190.          RE(3,2,1)= 0.D0
  191.          RE(3,3,1)= 0.D0
  192. * on definit explicitement les termes symetriques car on a constaté
  193. * des petites differences aux resultats si on le fait pas
  194.          RE(1,2,1)= RE(2,1,1)
  195.          RE(1,3,1)= RE(3,1,1)
  196.          RE(2,3,1)= RE(3,2,1)
  197.          do ioup=2,nelrig
  198.            do io=1,re(/2)
  199.              do iu=1,re(/1)
  200.               re(iu,io,ioup)=re(iu,io,1)
  201.              enddo
  202.            enddo
  203.          enddo
  204.        SEGDES XMATRI
  205. *       SEGDES IMATRI
  206. * boucle sur les differents types de matrices
  207.        DO 10 IAA= 1,L1
  208.         IRIGEL(2,IAA) = 0
  209.         IRIGEL(5,IAA) = NIFOUR
  210.         IRIGEL(6,IAA) = 0
  211.         IRIGEL(7,IAA) = 0
  212.         IRIGEL(4,IAA) = xMATRI
  213.         COERIG(IAA) =1.D0
  214. * initialisation du segment melem associé aux blocages
  215.         NBELEM = NBPOIC-1
  216.         SEGINI IPT1
  217.         IRIGEL(1,IAA) = IPT1
  218.         IPT1.ITYPEL = 22
  219. * on remplit le tableau des descripteurs
  220.         SEGINI DESCR
  221.         IRIGEL(3,IAA)=DESCR
  222.         LISINC(1)='LX'
  223.         LISDUA(1)='FLX'
  224.         NOELEP(1)=1
  225.         NOELED(1)=1
  226.          IF (IDIM.EQ.3) THEN
  227.           LISINC(2)= MOROTA(IAA)
  228.           LISINC(3)= MOROTA(IAA)
  229.           LISDUA(2)= MORODU(IAA)
  230.           LISDUA(3)= MORODU(IAA)
  231.          ELSE IF (IFOMOD.EQ.-1) THEN
  232.           LISINC(2)= MOROTA(3)
  233.           LISINC(3)= MOROTA(3)
  234.           LISDUA(2)= MORODU(3)
  235.           LISDUA(3)= MORODU(3)
  236.          ELSE IF (ABS(NIFOUR).EQ.1) THEN
  237.           LISINC(2)= MOROTA(4)
  238.           LISINC(3)= MOROTA(4)
  239.           LISDUA(2)= MORODU(4)
  240.           LISDUA(3)= MORODU(4)
  241.          ENDIF
  242.         NOELEP(2)=2
  243.         NOELEP(3)=3
  244.         NOELED(2)=2
  245.         NOELED(3)=3
  246.         SEGDES DESCR
  247. *  boucle sur les points du maillage ayant des ddl de rotation
  248.          DO 20 II=1,NBELEM
  249.               IP2 = NUM(1,(II+1))
  250.               IREFP2 = (IP2-1)*(IDIM+1)
  251.               X2 =  XCOOR(IREFP2+1)
  252.               Y2 =  XCOOR(IREFP2+2)
  253.               IF (IDIM.EQ.3) Z2 =  XCOOR(IREFP2+3)
  254.               IPT1.ICOLOR(II) = IDCOUL
  255. * points associés aux multiplicateurs
  256.               IPT1.NUM(1,II) = NBNOI + 1
  257.               IREFM1 = NBNOI*(IDIM+1)
  258.               NBNOI = NBNOI + 1
  259.               IPT1.NUM(2,II) = IP1
  260.               IPT1.NUM(3,II) = IP2
  261.               XCOOR(IREFM1+1) = (X1 + X2)/2
  262.               XCOOR(IREFM1+2) = (Y1 + Y2)/2
  263.                IF (IDIM.EQ.3) THEN
  264.                 XCOOR(IREFM1+3) = (Z1 + Z2)/2
  265.                ENDIF
  266.  20     CONTINUE
  267.         SEGDES IPT1
  268.        IND = IAA
  269.  10    CONTINUE
  270.       ENDIF
  271.  
  272. *  fin de relations sur les rotations on passe
  273. * aux relations entre le noeud maitre et les depl. des autres noeuds
  274.        IF (IDIM.EQ.3) NLIGRE = 5
  275.        IF (IDIM.EQ.2) NLIGRE = 4
  276.        NLIGRP = NLIGRE
  277.        NLIGRD = NLIGRE
  278.        NELRIG = (NBTOT-1)
  279.        NBELEM = NBTOT-1
  280. * boucle sur les differents types de matrices
  281.       DO 40 IAAA= 1,L2
  282.         IAA = IND + IAAA
  283. * relations entre rt et uz et ur = -ut en fourier 1
  284.        IF((ABS(NIFOUR).EQ.1).AND.(IAAA.gt.1)) then
  285.          nligre = 3
  286.          nligrp = nligre
  287.          nligrd = nligre
  288.          NELRIG = NBTOT
  289.          NBELEM = NBTOT
  290.        ENDIF
  291. * initialisation du segment melem associé aux blocages
  292.         SEGINI IPT1
  293.         IPT1.ITYPEL = 22
  294. *
  295.         IRIGEL(1,IAA) = IPT1
  296.         IRIGEL(2,IAA) = 0
  297.         IRIGEL(5,IAA) = NIFOUR
  298.         IRIGEL(6,IAA) = 0
  299.         IRIGEL(7,IAA) = 0
  300.         SEGINI xMATRI
  301.         IRIGEL(4,IAA) = xMATRI
  302.         COERIG(IAA) =1.D0
  303. * on remplit le tableau des descripteurs
  304.         SEGINI DESCR
  305.         IRIGEL(3,IAA)=DESCR
  306.         LISINC(1)='LX'
  307.         LISDUA(1)='FLX'
  308.         NOELEP(1)=1
  309.         NOELED(1)=1
  310.  
  311.         NOELEP(2)=3
  312.         NOELEP(3)=2
  313.         NOELED(2)=3
  314.         NOELED(3)=2
  315.        IF (.NOT.((ABS(NIFOUR).EQ.1).AND.(IAAA.gt.1)))THEN
  316.         NOELEP(4)=2
  317.         NOELED(4)=2
  318.        endif
  319.         IF ((ABS(NIFOUR).EQ.1).and.(iaaa.eq.1)) kk = 4
  320.         IF ((IFOMOD.EQ.2).OR.(IFOMOD.EQ.-1)) KK = IAAA
  321.         LISINC(2)= MODEPL(KK)
  322.         LISINC(3)= MODEPL(KK)
  323.         LISDUA(2)= MODEDU(KK)
  324.         LISDUA(3)= MODEDU(KK)
  325. * relation entre rt et uz en fourier 1
  326.         IF ((ABS(NIFOUR).EQ.1).and.(iaaa.eq.2)) then
  327.         LISINC(2)= MODEPL(3)
  328.         LISINC(3)= MOROTA(4)
  329.         LISDUA(2)= MODEDU(3)
  330.         LISDUA(3)= MORODU(4)
  331.         endif
  332. * relation entre ur et ut en fourier 1
  333.        if ((ABS(NIFOUR).EQ.1).AND.(IAAA.eq.3)) then
  334.         LISINC(2)= MODEPL(4)
  335.         LISINC(3)= MODEPL(5)
  336.         LISDUA(2)= MODEDU(4)
  337.         LISDUA(3)= MODEDU(5)
  338.        ENDIF
  339.  
  340.         IF (IDIM.EQ.3) THEN
  341.          IF (IAAA.EQ.1) THEN
  342.            LISINC(4)= MOROTA(2)
  343.            LISINC(5)= MOROTA(3)
  344.            LISDUA(4)= MORODU(2)
  345.            LISDUA(5)= MORODU(3)
  346.          ELSE IF (IAAA.EQ.2) THEN
  347.            LISINC(4)= MOROTA(3)
  348.            LISINC(5)= MOROTA(1)
  349.            LISDUA(4)= MORODU(3)
  350.            LISDUA(5)= MORODU(1)
  351.          ELSE
  352.            LISINC(4)= MOROTA(1)
  353.            LISINC(5)= MOROTA(2)
  354.            LISDUA(4)= MORODU(1)
  355.            LISDUA(5)= MORODU(2)
  356.          ENDIF
  357.         NOELEP(5)=2
  358.         NOELED(5)=2
  359. * cont. ou defo planes
  360.        ELSE IF (IFOMOD.EQ.-1) THEN
  361.         LISINC(4)= MOROTA(3)
  362.         LISDUA(4)= MORODU(3)
  363. * fourier 1 ou -1
  364.        ELSE IF ((ABS(NIFOUR).EQ.1).AND.(IAAA.eq.1)) THEN
  365.         LISINC(4)= MOROTA(4)
  366.         LISDUA(4)= MORODU(4)
  367.        ENDIF
  368.  
  369.        SEGDES DESCR
  370.  
  371. *  boucle sur les points du maillage total
  372.           DO 50 II=1,NBELEM
  373.            IF(NBELEM.NE.NBTOT) THEN
  374. * partie coques ou poutres
  375.             IF (II.LT.NBPOIC) IP2 = NUM(1,(II+1))
  376. * partie massif
  377.             IF (II.GE.NBPOIC) IP2 = IPT2.NUM(1,(II-NBPOIC+1))
  378.            ELSE
  379. * fourier 1 ou -1, relation ur = -ut et relation entre rt et uz
  380.             IF (II.LE.NBPOIC) IP2 = NUM(1,II)
  381.             IF (II.GT.NBPOIC) IP2 = IPT2.NUM(1,(II-NBPOIC))
  382.            ENDIF
  383.             IREFP2 = (IP2-1)*(IDIM+1)
  384.             X2 =  XCOOR(IREFP2+1)
  385.             Y2 =  XCOOR(IREFP2+2)
  386.             IF (IDIM.EQ.3) Z2 =  XCOOR(IREFP2+3)
  387.             IPT1.ICOLOR(II) = IDCOUL
  388. * points associés aux multiplicateurs
  389.             IPT1.NUM(1,II) = NBNOI + 1
  390.             IREFM1 = NBNOI*(IDIM+1)
  391.             NBNOI = NBNOI + 1
  392.               IF((ABS(NIFOUR).EQ.1).AND.(IAAA.EQ.3)) THEN
  393.                 IP1 = IP2
  394.                 X1 = X2
  395.                 Y1 = Y2
  396.               ENDIF
  397.             IPT1.NUM(2,II) = IP1
  398.             IPT1.NUM(3,II) = IP2
  399.             XCOOR(IREFM1+1) = (X1 + X2)/2
  400.             XCOOR(IREFM1+2) = (Y1 + Y2)/2
  401.               IF (IDIM.EQ.3) THEN
  402.                 XCOOR(IREFM1+3) = (Z1 + Z2)/2
  403.               ENDIF
  404. * on remplit les valeurs RE de la matrice
  405. *            SEGINI XMATRI
  406. *            IXMATR = XMATRI
  407. *            IMATTT(II) = IXMATR
  408.  
  409.             IF (IAAA.EQ.1) THEN
  410.               COEF1 = Z2-Z1
  411.               COEF2 = Y2-Y1
  412.             ELSE IF (IAAA.EQ.2) THEN
  413.               COEF1 = X2-X1
  414.               COEF2 = Z2-Z1
  415.             ELSE
  416.               COEF1 = Y2-Y1
  417.               COEF2 = X2-X1
  418.             ENDIF
  419.  
  420.             RE(1,1,ii)=  0.D0
  421.             RE(2,1,ii)= 1.D0
  422.             RE(3,1,ii)= -1.D0
  423.        if (abs(nifour).eq.1) then
  424. * relation entre uz et rt en fourier 1
  425.           if (iaaa.eq.2) then
  426.             re(3,1,ii) = -x2
  427.           endif
  428. * relation ur = -ut en fourier 1
  429.           if (iaaa.eq.3) then
  430.             RE(3,1,ii)= 1.D0
  431.           endif
  432.        ENDIF
  433.           IF (IDIM.EQ.3) THEN
  434.             RE(4,1,ii)= -1.D0*COEF1
  435.             RE(5,1,ii)=  1.D0*COEF2
  436.           ELSE IF (IFOMOD.EQ.-1) THEN
  437.            IF (IAAA.EQ.1) THEN
  438.              RE(4,1,ii)= 1.D0*COEF2
  439.            ELSE
  440.              RE(4,1,ii)= -1.D0*COEF1
  441.            ENDIF
  442.           ELSE  IF ((ABS(NIFOUR).EQ.1).and.(iaaa.eq.1)) then
  443. * relation entre ur1, ur2 et rt1 en fourier 1
  444. *  le signe ne respecte pas le triedre orthonorme de fourier mais
  445. *  celui des calculs plans. Ce n'est pas tres elegant mais c'est
  446. *  comme ca dans C2000 !!!!
  447.              RE(4,1,ii)= 1.D0*COEF2
  448.           ENDIF
  449.  
  450.               DO 7 I=1,1
  451.                 DO 6 J=2,NLIGRE
  452.                   RE(I,J,ii)=RE(J,I,ii)
  453.   6             CONTINUE
  454.   7           CONTINUE
  455.  
  456.               DO 3 I=2,NLIGRE
  457.                 DO 4 J=2,NLIGRE
  458.                   RE(I,J,ii)=0.D0
  459.   4             CONTINUE
  460.   3           CONTINUE
  461.  
  462. *           SEGDES XMATRI
  463.  50       CONTINUE
  464.        SEGDES xMATRI
  465.        SEGDES IPT1
  466.  40   CONTINUE
  467.       GOTO 1000
  468.  
  469. *
  470. *** fin 3D ou (2d plan cont ou defo) ou (fourier 1)
  471. *
  472.  
  473.  100   CONTINUE
  474. *
  475. *** fourier 0 ou axis
  476. *
  477.       NBNN = 2
  478.  
  479.       IF (IFOMOD.EQ.0) THEN
  480. * axis : UR=0  RT=0  UZ = cte
  481.         L2 = 2
  482.         NNMAT = 3
  483.         NBRELA = NBPOIC*3 + NBPOIM*2 - 1
  484. * cas sans rotation
  485.          if (irota.eq.0) then
  486.            nnmat = 2
  487.            nbrela = nbpoic*2 -1
  488.          endif
  489.       ELSE
  490. * fourier 0 : UR=0  RT=0  UZ = cte  relation d'analogie sur UT
  491.         L2 = 3
  492.         NNMAT = 4
  493.         NBRELA = NBPOIC*4 + NBPOIM*3 - 2
  494. * cas sans rotation
  495.          if (irota.eq.0) then
  496.            nnmat = 3
  497.            nbrela = nbpoic*3 -2
  498.          endif
  499.       ENDIF
  500. * on ajuste MCOORD pour les noeuds associes aux multiplicateurs
  501.        NBPTS = NBNO + NBRELA
  502.        NBNOI = NBNO
  503.        SEGADJ MCOORD
  504. * initialisation du segment mrigid
  505.       NRIGE=7
  506.       NRIGEL=NNMAT
  507.       SEGINI MRIGID
  508.       ICHOLE=0
  509.       IMGEO1=0
  510.       IMGEO2=0
  511.       ISUPEQ=0
  512.       IFORIG=IFOUR
  513.       MTYMAT='RIGIDITE'
  514.       KRIGI=MRIGID
  515.        if (irota.eq.0) goto 121
  516. *  rotation RT = 0
  517.       NELRIG = NBPOIC
  518.         NLIGRE = 2
  519.         NLIGRP = NLIGRE
  520.         NLIGRD = NLIGRE
  521. *        SEGINI IMATRI
  522.         SEGINI XMATRI
  523. *        IXMATR=XMATRI
  524. *          DO 105 I=1,NELRIG
  525. *            IMATTT(I) = IXMATR
  526. *  105     CONTINUE
  527. * on remplit les valeurs RE de la matrice pour les rotations
  528.          RE(1,1,1)=  0.D0
  529.          RE(2,1,1)= 1.D0
  530.          RE(2,2,1)= 0.D0
  531.          RE(1,2,1)= RE(2,1,1)
  532.          do ioup=2,nelrig
  533.            do io=1,re(/2)
  534.              do iu=1,re(/1)
  535.                 re(iu,io,ioup)=re(iu,io,1)
  536.               enddo
  537.            enddo
  538.          enddo
  539. *       SEGDES XMATRI
  540.        SEGDES xMATRI
  541.  
  542.         IRIGEL(2,1) = 0
  543.         IRIGEL(5,1) = NIFOUR
  544.         IRIGEL(6,1) = 0
  545.         IRIGEL(7,1) = 0
  546.         IRIGEL(4,1) = xMATRI
  547.         COERIG(1) =1.D0
  548. * initialisation du segment melem associé aux blocages
  549.         NBELEM = NBPOIC
  550.         SEGINI IPT1
  551.         IRIGEL(1,1) = IPT1
  552.         IPT1.ITYPEL = 22
  553. * on remplit le tableau des descripteurs
  554.         SEGINI DESCR
  555.         IRIGEL(3,1)=DESCR
  556.         LISINC(1)='LX'
  557.         LISDUA(1)='FLX'
  558.         LISINC(2)= MOROTA(4)
  559.         LISDUA(2)= MORODU(4)
  560.         NOELEP(1)=1
  561.         NOELED(1)=1
  562.         NOELEP(2)=2
  563.         NOELED(2)=2
  564.         SEGDES DESCR
  565. *  boucle sur les points du maillage ayant des ddl de rotation
  566.          DO 120 II=1,NBELEM
  567.             IP2 = NUM(1,II)
  568.             IREFP2 = (IP2-1)*(IDIM+1)
  569.             X2 =  XCOOR(IREFP2+1)
  570.             Y2 =  XCOOR(IREFP2+2)
  571.             IPT1.ICOLOR(II) = IDCOUL
  572. * points associés aux multiplicateurs
  573.             IPT1.NUM(1,II) = NBNOI + 1
  574.             IREFM1 = NBNOI*(IDIM+1)
  575.             NBNOI = NBNOI + 1
  576.             IPT1.NUM(2,II) = IP2
  577.             XCOOR(IREFM1+1) = X2
  578.             XCOOR(IREFM1+2) = Y2
  579.  120    CONTINUE
  580.       SEGDES IPT1
  581.  121   continue
  582.  
  583. *  fin de relations sur la rotation on passe aux relations
  584. *  sur les déplacements
  585.       DO 140 IAAA= 1,L2
  586.        IAA = 1 + IAAA
  587.        if (irota.eq.0) iaa = iaaa
  588.         IF (IAAA.EQ.1) THEN
  589.           NLIGRE = 2
  590.           NBELEM = NBTOT
  591.         ELSE
  592.           NLIGRE =3
  593.           NBELEM = NBTOT-1
  594.           NBNN = 3
  595.         ENDIF
  596.        NLIGRP = NLIGRE
  597.        NLIGRD = NLIGRE
  598.        NELRIG = NBELEM
  599. * initialisation du segment melem associé aux blocages
  600.         SEGINI IPT1
  601.         IPT1.ITYPEL = 22
  602.         IRIGEL(1,IAA) = IPT1
  603.         IRIGEL(2,IAA) = 0
  604.         IRIGEL(5,IAA) = NIFOUR
  605.         IRIGEL(6,IAA) = 0
  606.         IRIGEL(7,IAA) = 0
  607.         SEGINI xMATRI
  608.  
  609.  
  610.         IRIGEL(4,IAA) = xMATRI
  611.         COERIG(IAA) =1.D0
  612. * on remplit le tableau des descripteurs
  613.         SEGINI DESCR
  614.         IRIGEL(3,IAA)=DESCR
  615.         LISINC(1)='LX'
  616.         LISDUA(1)='FLX'
  617.         NOELEP(1)=1
  618.         NOELED(1)=1
  619.         NOELEP(2)=2
  620.         NOELED(2)=2
  621.          IF(IAAA.EQ.1) THEN
  622.           LISINC(2) = MODEPL(4)
  623.           LISDUA(2) = MODEDU(4)
  624.          ELSE
  625.           NOELEP(3)=4
  626.           NOELED(3)=4
  627.            IF(IAAA.EQ.2) THEN
  628.             LISINC(2) = MODEPL(3)
  629.             LISDUA(2) = MODEDU(3)
  630.             LISINC(3) = MODEPL(3)
  631.             LISDUA(3) = MODEDU(3)
  632.            ELSE
  633.             LISINC(2) = MODEPL(5)
  634.             LISDUA(2) = MODEDU(5)
  635.             LISINC(3) = MODEPL(5)
  636.             LISDUA(3) = MODEDU(5)
  637.            ENDIF
  638.          ENDIF
  639.         SEGDES DESCR
  640.           DO 150 II=1,NBELEM
  641.            IF(IAAA.GT.1) THEN
  642.             IF (II.LT.NBPOIC) IP2 = NUM(1,(II+1))
  643.             IF (II.GE.NBPOIC) IP2 = IPT2.NUM(1,(II-NBPOIC+1))
  644.            ELSE
  645.             IF (II.LE.NBPOIC) IP2 = NUM(1,II)
  646.             IF (II.GT.NBPOIC) IP2 = IPT2.NUM(1,(II-NBPOIC))
  647.            ENDIF
  648.             IREFP2 = (IP2-1)*(IDIM+1)
  649.             X2 =  XCOOR(IREFP2+1)
  650.             Y2 =  XCOOR(IREFP2+2)
  651.             IPT1.ICOLOR(II) = IDCOUL
  652. * points associés aux multiplicateurs
  653.             IPT1.NUM(1,II) = NBNOI + 1
  654.             IREFM1 = NBNOI*(IDIM+1)
  655.             NBNOI = NBNOI + 1
  656.             IPT1.NUM(3,II) = IP2
  657.              IF(IAAA.GT.1) THEN
  658.               IPT1.NUM(4,II) = IP1
  659.               XCOOR(IREFM1+1) = (X1 + X2)/2
  660.               XCOOR(IREFM1+2) = (Y1 + Y2)/2
  661.              ELSE
  662.               XCOOR(IREFM1+1) = X2
  663.               XCOOR(IREFM1+2) = Y2
  664.              ENDIF
  665.  
  666. * on remplit les valeurs RE de la matrice
  667.  
  668. *             SEGINI XMATRI
  669. *             IXMATR = XMATRI
  670.            IF(IAAA.EQ.1) THEN
  671.              RE(1,1,ii)= 0.D0
  672.              RE(2,1,ii)= 1.D0
  673.              RE(2,2,ii)= 0.D0
  674.              RE(1,2,ii)= RE(2,1,ii)
  675.              RE(1,2,ii)= RE(3,1,ii)
  676.             ELSE
  677.               RE(1,1,ii)=  0.D0
  678.               RE(2,1,ii)= 1.D0
  679.                IF (IAAA.EQ.2) THEN
  680.                 RE(3,1,ii)= -1.D0
  681.                ELSE
  682.                 COEF1 = X2/X1
  683.                 RE(3,1,ii)= -1.D0*COEF1
  684.                ENDIF
  685.               RE(2,2,ii)= 0.D0
  686.               RE(3,2,ii)= 0.D0
  687.               RE(3,3,ii)= 0.D0
  688.               RE(1,2,ii)= RE(2,1,ii)
  689.               RE(1,3,ii)= RE(3,1,ii)
  690.               RE(2,3,ii)= RE(3,2,ii)
  691.             ENDIF
  692.  
  693. *            SEGDES XMATRI
  694. *            IMATTT(II) = IXMATR
  695.  150      CONTINUE
  696.        SEGDES xMATRI
  697.        SEGDES IPT1
  698.  140  CONTINUE
  699.  
  700.  1000 CONTINUE
  701.       SEGDES MRIGID
  702.       CALL ECROBJ('RIGIDITE', KRIGI)
  703.       IF (LP.EQ.0) SEGDES MELEME
  704.       IF (IPM.NE.0) SEGDES IPT2
  705.       RETURN
  706.       END
  707.  
  708.  
  709.  
  710.  
  711.  
  712.  
  713.  
  714.  

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