Télécharger la plaquette Cast3M


fr en

Télécharger ricabl.eso

Retour à la liste

Numérotation des lignes : 

ricabl

  1. C RICABL    SOURCE    FANDEUR   22/01/03    21:15:43     11237          
  2.       SUBROUTINE RICABL
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5.  
  6. -INC PPARAM
  7. -INC CCOPTIO
  8. -INC SMELEME
  9. -INC SMRIGID
  10. -INC SMCOORD
  11.       SEGMENT ITRA
  12.           REAL*8 COR(6),XK(6,6),C(3),D(3),E(3)
  13.       ENDSEGMENT
  14.       CHARACTER*4 MOTU(3),MOTF(3)
  15.       DATA MOTU/'UX  ','UY  ','UZ  '/,MOTF/'FX  ','FY  ','FZ  '/
  16.       CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)
  17.       IF(IERR.NE.0) RETURN
  18.       CALL LIRREE(XVAL,1,IRETOU)
  19.       IF(IERR.NE.0) RETURN
  20.       FE=XVAL
  21.       CALL LIRREE(XVAL,1,IRETOU)
  22.       IF(IERR.NE.0) RETURN
  23.       EPS=XVAL
  24.       IF(XVAL.LE.0.) CALL ERREUR(368)
  25.       IF(IERR.NE.0) RETURN
  26.       SEGACT MELEME
  27.       IF(LISOUS(/1).NE.0) CALL ERREUR (369)
  28.       IF(IERR.NE.0) RETURN
  29.       IF(ITYPEL.NE.2)CALL ERREUR (369)
  30.       IF(IERR.NE.0) RETURN
  31.       NRIGE=8
  32.       NRIGEL=idim +1
  33.       SEGINI MRIGID
  34. C
  35. C  *** CREATION D'UN NOUVEAU MELEME A 2 POINTS POUR Y APPUYER LA
  36. C  *** RIGIDITE PROPRE AU CABLE.ON CALCULE LA RIGIDITE AU FUR ET A
  37. C  ***  MESURE .ON CREE UN NOUVEAU NOEUD A LA MEME
  38. C  *** PLACE QUE LE DEUXIEME ET ON METTRA EN RELATION UNILATERALES
  39. C  *** CES DEUX NOEUDS CONFONDUS
  40. C
  41.       IFORIG=IFOUR
  42.       IRIGEL(5,1)=NIFOUR
  43.       IRIGEL(5,2)=NIFOUR
  44.       MTYMAT='RIGIDITE'
  45.       COERIG(1)=1.D0
  46.       COERIG(2)=1.D0
  47.       COERIG(3)=1.D0
  48.       if(idim.eq.3)COERIG(4)=1.D0
  49.       NBNN=2
  50.       NBELEM=NUM(/2)
  51.       NLIGRP = IDIM*2
  52.       NLIGRD = IDIM*2
  53.       SEGINI DESCR
  54.       NELRIG=NBELEM
  55.       SEGINI xMATRI
  56.       NBSOUS=0
  57.       NBREF=0
  58.       SEGINI IPT1
  59.       IRIGEL(1,1)=IPT1
  60.       IRIGEL(4,1)=xMATRI
  61.       LVAL=10+ ( IDIM-2)* 11
  62.       IRIGEL(3,1)=DESCR
  63.       LISINC(1)=MOTU(1)
  64.       NOELEP(1)=1
  65.       NOELED(1)=1
  66.       LISDUA(1)=MOTF(1)
  67.       LISINC(2)=MOTU(2)
  68.       NOELEP(2)=1
  69.       NOELED(2)=1
  70.       LISDUA(2)=MOTF(2)
  71.       IA=2
  72.       IF( IDIM.EQ.3) THEN
  73.           IA=3
  74.           LISINC(3)=MOTU(3)
  75.           LISDUA(3)=MOTF(3)
  76.           NOELEP(3)=1
  77.           NOELED(3)=1
  78.       ENDIF
  79.       LISINC(IA+1)=MOTU(1)
  80.       NOELEP(IA+1)=2
  81.       NOELED(IA+1)=2
  82.       LISDUA(IA+1)=MOTF(1)
  83.       LISINC(IA+2)=MOTU(2)
  84.       NOELEP(IA+2)=2
  85.       NOELED(IA+2)=2
  86.       LISDUA(IA+2)=MOTF(2)
  87.       IF( IDIM.EQ.3) THEN
  88.           LISINC(6)=MOTU(3)
  89.           LISDUA(6)=MOTF(3)
  90.           NOELEP(6)=2
  91.           NOELED(6)=2
  92.       ENDIF
  93.       SEGDES DESCR
  94.       IPT1.ITYPEL=2
  95.       SEGINI ITRA
  96.       segact mcoord*mod
  97. C
  98. C  ***  BOUCLE 1 SUR LES ELEMENTS ON CREE LE MELEME ET ON FAIT LA
  99. C  ***  RIGIDITE DU CABLE EN TRACTION COMPRESSION
  100. C  ***  LES CONDITIONS UNILATERALES SERONT FAITES PLUS TARD
  101.  
  102.       DO 1 I=1,NBELEM
  103.       IP=NUM(1,I)
  104.       IPT1.NUM(1,I)=IP
  105.       IPDE=(IP-1)*( IDIM+1)
  106.       COR(1)=XCOOR(IPDE+1)
  107.       COR(2)=XCOOR(IPDE+2)
  108.       COR(3)=0
  109.       IF( IDIM.EQ.3)COR(3)=XCOOR(IPDE+3)
  110.       NP=(NUM(2,I)-1)*(IDIM+1)
  111.       IPT1.NUM(2,I)=nbpts +1
  112.       XCOOR(**)= XCOOR(NP+1)
  113.       XCOOR(**)=XCOOR(NP+2)
  114.       IF(IDIM.EQ.3) XCOOR(**)=XCOOR(NP+3)
  115.       COR(4)= XCOOR(NP+1)
  116.       COR(5)=XCOOR(NP+2)
  117.       COR(6)=0
  118.       IF(IDIM.EQ.3)COR(6)=XCOOR(NP+3)
  119.       XCOOR(**)=XCOOR(NP+1+IDIM)
  120.       nbpts=nbpts+1
  121.       X21=COR(4)-COR(1)
  122.       Y21=COR(5)-COR(2)
  123.       Z21=COR(6)-COR(3)
  124.       XL=SQRT(X21*X21+Y21*Y21+Z21*Z21)
  125.       C(1)=X21/XL
  126.       C(2)=Y21/XL
  127.       C(3)=Z21/XL
  128.       R=FE/(EPS*XL)
  129.       DO 2 K=1,idim
  130.       K1=K+idim
  131.       DO 2 J=1,idim
  132.       J1=J+idim
  133.       XK(K,J)=C(K)*R*C(J)
  134.       XK(K1,J1)=XK(K,J)
  135.       XK(K ,J1)=-XK(K,J)
  136.       XK(K1,J )=-XK(K,J)
  137.   2   CONTINUE
  138.       KJ=1
  139. *      SEGINI XMATRI
  140. *      DO 3 K=1,2*IDIM
  141. *      KJ=KJ+K-1
  142. *      K1=K
  143. *      IF(IDIM.EQ.2.AND.K.GT.IDIM) K1=K1+1
  144. *      DO 3 J=1,K
  145. *      IK=J-1
  146. *      J1=J
  147. *      IF(IDIM.EQ.2.AND.J.GT.IDIM) J1=J1+1
  148. *      RE(KJ+IK)=XK(K1,J1)
  149. *  3   CONTINUE
  150.       DO 3 K=1,IDIM*2
  151.       DO 3 J=1,IDIM*2
  152.       RE(J,K,i)=XK(J,K)
  153.    3  CONTINUE
  154. *      SEGDES XMATRI
  155. *      IMATTT(I)=XMATRI
  156.    1  CONTINUE
  157.       SEGDES xMATRI
  158. C
  159. C  **** ON REPREND TOUS LES ELEMENTS POUR CREER LES CONDITIONS
  160. C  **** UNILATERALES
  161. C
  162.       NLIGRP=IDIM*2 + 2
  163.       NLIGRD=IDIM*2 + 2
  164.       NBNN=4
  165.       SEGINI DESCR
  166.       LISINC(1)='LX  '
  167.       LISDUA(1)='FLX'
  168.       NOELEP(1)=1
  169.       NOELED(1)=1
  170.       LISINC(2)='LX  '
  171.       LISDUA(2)='FLX'
  172.       NOELEP(2)=2
  173.       NOELED(2)=2
  174.       LISINC(3)=MOTU(1)
  175.       LISDUA(3)=MOTF(1)
  176.       NOELEP(3)=3
  177.       NOELED(3)=3
  178.       LISINC(4)=MOTU(2)
  179.       LISDUA(4)=MOTF(2)
  180.       NOELEP(4)=3
  181.       NOELED(4)=3
  182.       IA=2
  183.       IF(IDIM.EQ.3) THEN
  184.           LISINC(5)=MOTU(3)
  185.           LISDUA(5)=MOTF(3)
  186.           NOELEP(5)=3
  187.           NOELED(5)=3
  188.           IA=3
  189.       ENDIF
  190.       LISINC(IA+3)=MOTU(1)
  191.       LISDUA(IA+3)=MOTF(1)
  192.       NOELEP(IA+3)=4
  193.       NOELED(IA+3)=4
  194.       LISINC(IA+4)=MOTU(2)
  195.       LISDUA(IA+4)=MOTF(2)
  196.       NOELEP(IA+4)=4
  197.       NOELED(IA+4)=4
  198.       IF(IDIM.EQ.3) THEN
  199.           LISINC(8)=MOTU(3)
  200.           LISDUA(8)=MOTF(3)
  201.           NOELEP(8)=4
  202.           NOELED(8)=4
  203.       ENDIF
  204.       SEGDES DESCR
  205.       IRIGEL(3,2)=DESCR
  206.       IRIGEL(3,3)=DESCR
  207.       if(idim.eq.3)IRIGEL(3,4)=DESCR
  208.       SEGINI xMATRI
  209.       IRIGEL(4,2)=xMATRI
  210.       SEGINI IPT2
  211.       IPT2.ITYPEL=22
  212.       IRIGEL(1,2)=IPT2
  213.       IRIGEL(5,2)=NIFOUR
  214.       IRIGEL(5,3)=NIFOUR
  215.       if (idim.eq.3)IRIGEL(5,4)=NIFOUR
  216.       IRIGEL(6,2)=1
  217.       IRIGEL(6,3)=0
  218.        if( idim.eq.3) IRIGEL(6,4)=0
  219. *      LVAL=(NLIGRE*NLIGRE+NLIGRE)/2
  220. C
  221. C  ****  BOUCLE SUR LES ELEMENTS ON CREES IPT2 ET LES RIGIDITES
  222. C
  223.       DO 500 JOP=1,idim
  224.       IF(JOP.GE.2) THEN
  225.            SEGDES xMATRI,IPT2
  226.            SEGINI xMATRI,IPT2
  227.            IPT2.ITYPEL=22
  228.            IRIGEL(1,JOP+1)=IPT2
  229.            IRIGEL(4,JOP+1)=xMATRI
  230.       ENDIF
  231.       DO 50 I=1,NBELEM
  232.       I1=NUM(2,I)
  233.       I2=IPT1.NUM(2,I)
  234.       IL1=nbpts+1
  235.       IL2=IL1+1
  236.       IN1=(I1-1)*(IDIM+1)
  237.       IN2=(I2-1)*(IDIM+1)
  238.       XCOOR(**)=XCOOR(IN1+1)
  239.       XCOOR(**)=XCOOR(IN1+2)
  240.       IF(IDIM.EQ.3)XCOOR(**)=XCOOR(IN1+3)
  241.       XCOOR(**)=XCOOR(IN1+IDIM+1)
  242.       XCOOR(**)=XCOOR(IN2+1)
  243.       XCOOR(**)=XCOOR(IN2+2)
  244.       IF(IDIM.EQ.3)XCOOR(**)=XCOOR(IN2+3)
  245.       XCOOR(**)=XCOOR(IN1+IDIM+1)
  246.       nbpts=nbpts+2
  247.       IPT2.NUM(1,I)=IL1
  248.       IPT2.NUM(2,I)=IL2
  249.       IPT2.NUM(3,I)=I1
  250.       IPT2.NUM(4,I)=I2
  251. *      SEGINI XMATRI
  252.       RE(1,1,i)=-1.D0
  253.       RE(2,1,i)=1.D0
  254.       RE(1,2,i)=1.D0
  255.       RE(2,2,i)=-1.D0
  256.       IP1=NUM(1,I)
  257.       INP1=(IP1-1)*(IDIM+1)
  258.       C(1)=XCOOR(IN1+1)-XCOOR(INP1+1)
  259.       C(2)=XCOOR(IN1+2)-XCOOR(INP1+2)
  260.       C(3)=0.D0
  261.       IF(IDIM.EQ.3) C(3)=XCOOR(IN1+3)-XCOOR(INP1+3)
  262.       XL= SQRT( C(1)*C(1)+C(2)*C(2)+C(3)*C(3))
  263.       C(1)=C(1)/XL
  264.       C(2)=C(2)/XL
  265.       C(3)=C(3)/XL
  266.       IF(JOP.EQ.2) THEN
  267.          D(1)=-C(2)
  268.          D(2)=C(1)
  269.          D(3)=0.D0
  270.          XL=SQRT(D(1)*D(1)+D(2)*D(2)+D(3)*D(3))
  271.          IF(XL.LT.1.D-3) THEN
  272.               D(1)=-C(3)
  273.               D(2)=0D0
  274.               D(3)=C(1)
  275.               XL=SQRT(D(1)*D(1)+D(2)*D(2)+D(3)*D(3))
  276.          ENDIF
  277.          C(1)=D(1)/XL
  278.          C(2)=D(2)/XL
  279.          C(3)=D(3)/XL
  280.       ENDIF
  281.       IF(JOP.EQ.3) THEN
  282.          D(1)=-C(2)
  283.          D(2)=C(1)
  284.          D(3)=0.
  285.          XL=SQRT(D(1)*D(1)+D(2)*D(2)+D(3)*D(3))
  286.          IF(XL.LT.1.D-3) THEN
  287.               D(1)=-C(3)
  288.               D(2)=0.
  289.               D(3)=C(1)
  290.               XL=SQRT(D(1)*D(1)+D(2)*D(2)+D(3)*D(3))
  291.          ENDIF
  292.          D(1)=D(1)/XL
  293.          D(2)=D(2)/XL
  294.          D(3)=D(3)/XL
  295.          E(1)=C(2)*D(3)-C(3)*D(2)
  296.          E(2)=C(3)*D(1)-C(1)*D(3)
  297.          E(3)=C(1)*D(2)-C(2)*D(1)
  298.          C(1)=E(1)
  299.          C(2)=E(2)
  300.          C(3)=E(3)
  301.       ENDIF
  302.       RE(3,1,i)=C(1)
  303.       RE(3,2,i)=C(1)
  304.       RE(1,3,i)=C(1)
  305.       RE(2,3,i)=C(1)
  306.       RE(4,1,i)=C(2)
  307.       RE(4,2,i)=C(2)
  308.       RE(1,4,i)=C(2)
  309.       RE(2,4,i)=C(2)
  310.       IA=4
  311. *      IB=15
  312.       IF(IDIM.EQ.3) THEN
  313.            RE(5,1,i)=C(3)
  314.            RE(5,2,i)=C(3)
  315.            RE(1,5,i)=C(3)
  316.            RE(2,5,i)=C(3)
  317.            IA=5
  318. *           IB=21
  319.       ENDIF
  320.       RE(IA+1,1,i)=-C(1)
  321.       RE(IA+1,2,i)=-C(1)
  322.       RE(1,IA+1,i)=-C(1)
  323.       RE(2,IA+1,i)=-C(1)
  324.       RE(IA+2,1,i)=-C(2)
  325.       RE(IA+2,2,i)=-C(2)
  326.       RE(1,IA+2,i)=-C(2)
  327.       RE(2,IA+2,i)=-C(2)
  328.       IF(IDIM.EQ.3) THEN
  329.           RE(IA+3,1,i)=-C(3)
  330.           RE(IA+3,2,i)=-C(3)
  331.           RE(1,IA+3,i)=-C(3)
  332.           RE(2,IA+3,i)=-C(3)
  333.       ENDIF
  334. *      SEGDES XMATRI
  335. *      IMATTT(I)=XMATRI
  336.    50 CONTINUE
  337.   500 CONTINUE
  338.       SEGDES MELEME,IPT1,IPT2,xMATRI
  339.       SEGDES MRIGID
  340.       SEGSUP ITRA
  341.       CALL ECROBJ('RIGIDITE',MRIGID)
  342.       RETURN
  343.       END
  344.  
  345.  
  346.  
  347.  
  348.  
  349.  
  350.  

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