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    PV090527  26/04/30    21:16:15     12529          
  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.       rigrel=0
  56.       SEGINI xMATRI
  57.       NBSOUS=0
  58.       NBREF=0
  59.       SEGINI IPT1
  60.       IRIGEL(1,1)=IPT1
  61.       IRIGEL(4,1)=xMATRI
  62.       LVAL=10+ ( IDIM-2)* 11
  63.       IRIGEL(3,1)=DESCR
  64.       LISINC(1)=MOTU(1)
  65.       NOELEP(1)=1
  66.       NOELED(1)=1
  67.       LISDUA(1)=MOTF(1)
  68.       LISINC(2)=MOTU(2)
  69.       NOELEP(2)=1
  70.       NOELED(2)=1
  71.       LISDUA(2)=MOTF(2)
  72.       IA=2
  73.       IF( IDIM.EQ.3) THEN
  74.           IA=3
  75.           LISINC(3)=MOTU(3)
  76.           LISDUA(3)=MOTF(3)
  77.           NOELEP(3)=1
  78.           NOELED(3)=1
  79.       ENDIF
  80.       LISINC(IA+1)=MOTU(1)
  81.       NOELEP(IA+1)=2
  82.       NOELED(IA+1)=2
  83.       LISDUA(IA+1)=MOTF(1)
  84.       LISINC(IA+2)=MOTU(2)
  85.       NOELEP(IA+2)=2
  86.       NOELED(IA+2)=2
  87.       LISDUA(IA+2)=MOTF(2)
  88.       IF( IDIM.EQ.3) THEN
  89.           LISINC(6)=MOTU(3)
  90.           LISDUA(6)=MOTF(3)
  91.           NOELEP(6)=2
  92.           NOELED(6)=2
  93.       ENDIF
  94.       SEGDES DESCR
  95.       IPT1.ITYPEL=2
  96.       SEGINI ITRA
  97.       segact mcoord*mod
  98. C
  99. C  ***  BOUCLE 1 SUR LES ELEMENTS ON CREE LE MELEME ET ON FAIT LA
  100. C  ***  RIGIDITE DU CABLE EN TRACTION COMPRESSION
  101. C  ***  LES CONDITIONS UNILATERALES SERONT FAITES PLUS TARD
  102.  
  103.       DO 1 I=1,NBELEM
  104.       IP=NUM(1,I)
  105.       IPT1.NUM(1,I)=IP
  106.       IPDE=(IP-1)*( IDIM+1)
  107.       COR(1)=XCOOR(IPDE+1)
  108.       COR(2)=XCOOR(IPDE+2)
  109.       COR(3)=0
  110.       IF( IDIM.EQ.3)COR(3)=XCOOR(IPDE+3)
  111.       NP=(NUM(2,I)-1)*(IDIM+1)
  112.       IPT1.NUM(2,I)=nbpts +1
  113.       XCOOR(**)= XCOOR(NP+1)
  114.       XCOOR(**)=XCOOR(NP+2)
  115.       IF(IDIM.EQ.3) XCOOR(**)=XCOOR(NP+3)
  116.       COR(4)= XCOOR(NP+1)
  117.       COR(5)=XCOOR(NP+2)
  118.       COR(6)=0
  119.       IF(IDIM.EQ.3)COR(6)=XCOOR(NP+3)
  120.       XCOOR(**)=XCOOR(NP+1+IDIM)
  121.       nbpts=nbpts+1
  122.       X21=COR(4)-COR(1)
  123.       Y21=COR(5)-COR(2)
  124.       Z21=COR(6)-COR(3)
  125.       XL=SQRT(X21*X21+Y21*Y21+Z21*Z21)
  126.       C(1)=X21/XL
  127.       C(2)=Y21/XL
  128.       C(3)=Z21/XL
  129.       R=FE/(EPS*XL)
  130.       DO   K=1,idim
  131.       K1=K+idim
  132.       DO   J=1,idim
  133.       J1=J+idim
  134.       XK(K,J)=C(K)*R*C(J)
  135.       XK(K1,J1)=XK(K,J)
  136.       XK(K ,J1)=-XK(K,J)
  137.       XK(K1,J )=-XK(K,J)
  138.       enddo    
  139.       enddo    
  140.       KJ=1
  141. *      SEGINI XMATRI
  142. *      DO 3 K=1,2*IDIM
  143. *      KJ=KJ+K-1
  144. *      K1=K
  145. *      IF(IDIM.EQ.2.AND.K.GT.IDIM) K1=K1+1
  146. *      DO 3 J=1,K
  147. *      IK=J-1
  148. *      J1=J
  149. *      IF(IDIM.EQ.2.AND.J.GT.IDIM) J1=J1+1
  150. *      RE(KJ+IK)=XK(K1,J1)
  151. *  3   CONTINUE
  152.       DO   K=1,IDIM*2
  153.       DO   J=1,IDIM*2
  154.       RE(J,K,i)=XK(J,K)
  155.       enddo    
  156.       enddo    
  157. *      SEGDES XMATRI
  158. *      IMATTT(I)=XMATRI
  159.    1  CONTINUE
  160.       SEGDES xMATRI
  161. C
  162. C  **** ON REPREND TOUS LES ELEMENTS POUR CREER LES CONDITIONS
  163. C  **** UNILATERALES
  164. C
  165.       NLIGRP=IDIM*2 + 2
  166.       NLIGRD=IDIM*2 + 2
  167.       NBNN=4
  168.       SEGINI DESCR
  169.       LISINC(1)='LX  '
  170.       LISDUA(1)='FLX'
  171.       NOELEP(1)=1
  172.       NOELED(1)=1
  173.       LISINC(2)='LX  '
  174.       LISDUA(2)='FLX'
  175.       NOELEP(2)=2
  176.       NOELED(2)=2
  177.       LISINC(3)=MOTU(1)
  178.       LISDUA(3)=MOTF(1)
  179.       NOELEP(3)=3
  180.       NOELED(3)=3
  181.       LISINC(4)=MOTU(2)
  182.       LISDUA(4)=MOTF(2)
  183.       NOELEP(4)=3
  184.       NOELED(4)=3
  185.       IA=2
  186.       IF(IDIM.EQ.3) THEN
  187.           LISINC(5)=MOTU(3)
  188.           LISDUA(5)=MOTF(3)
  189.           NOELEP(5)=3
  190.           NOELED(5)=3
  191.           IA=3
  192.       ENDIF
  193.       LISINC(IA+3)=MOTU(1)
  194.       LISDUA(IA+3)=MOTF(1)
  195.       NOELEP(IA+3)=4
  196.       NOELED(IA+3)=4
  197.       LISINC(IA+4)=MOTU(2)
  198.       LISDUA(IA+4)=MOTF(2)
  199.       NOELEP(IA+4)=4
  200.       NOELED(IA+4)=4
  201.       IF(IDIM.EQ.3) THEN
  202.           LISINC(8)=MOTU(3)
  203.           LISDUA(8)=MOTF(3)
  204.           NOELEP(8)=4
  205.           NOELED(8)=4
  206.       ENDIF
  207.       SEGDES DESCR
  208.       IRIGEL(3,2)=DESCR
  209.       IRIGEL(3,3)=DESCR
  210.       if(idim.eq.3)IRIGEL(3,4)=DESCR
  211.       rigrel=0
  212.       SEGINI xMATRI
  213.       IRIGEL(4,2)=xMATRI
  214.       SEGINI IPT2
  215.       IPT2.ITYPEL=22
  216.       IRIGEL(1,2)=IPT2
  217.       IRIGEL(5,2)=NIFOUR
  218.       IRIGEL(5,3)=NIFOUR
  219.       if (idim.eq.3)IRIGEL(5,4)=NIFOUR
  220.       IRIGEL(6,2)=1
  221.       IRIGEL(6,3)=0
  222.        if( idim.eq.3) IRIGEL(6,4)=0
  223. *      LVAL=(NLIGRE*NLIGRE+NLIGRE)/2
  224. C
  225. C  ****  BOUCLE SUR LES ELEMENTS ON CREES IPT2 ET LES RIGIDITES
  226. C
  227.       DO 500 JOP=1,idim
  228.       IF(JOP.GE.2) THEN
  229.            SEGDES xMATRI,IPT2
  230.            SEGINI xMATRI,IPT2
  231.            IPT2.ITYPEL=22
  232.            IRIGEL(1,JOP+1)=IPT2
  233.            IRIGEL(4,JOP+1)=xMATRI
  234.       ENDIF
  235.       DO 50 I=1,NBELEM
  236.       I1=NUM(2,I)
  237.       I2=IPT1.NUM(2,I)
  238.       IL1=nbpts+1
  239.       IL2=IL1+1
  240.       IN1=(I1-1)*(IDIM+1)
  241.       IN2=(I2-1)*(IDIM+1)
  242.       XCOOR(**)=XCOOR(IN1+1)
  243.       XCOOR(**)=XCOOR(IN1+2)
  244.       IF(IDIM.EQ.3)XCOOR(**)=XCOOR(IN1+3)
  245.       XCOOR(**)=XCOOR(IN1+IDIM+1)
  246.       XCOOR(**)=XCOOR(IN2+1)
  247.       XCOOR(**)=XCOOR(IN2+2)
  248.       IF(IDIM.EQ.3)XCOOR(**)=XCOOR(IN2+3)
  249.       XCOOR(**)=XCOOR(IN1+IDIM+1)
  250.       nbpts=nbpts+2
  251.       IPT2.NUM(1,I)=IL1
  252.       IPT2.NUM(2,I)=IL2
  253.       IPT2.NUM(3,I)=I1
  254.       IPT2.NUM(4,I)=I2
  255. *      SEGINI XMATRI
  256.       RE(1,1,i)=-1.D0
  257.       RE(2,1,i)=1.D0
  258.       RE(1,2,i)=1.D0
  259.       RE(2,2,i)=-1.D0
  260.       IP1=NUM(1,I)
  261.       INP1=(IP1-1)*(IDIM+1)
  262.       C(1)=XCOOR(IN1+1)-XCOOR(INP1+1)
  263.       C(2)=XCOOR(IN1+2)-XCOOR(INP1+2)
  264.       C(3)=0.D0
  265.       IF(IDIM.EQ.3) C(3)=XCOOR(IN1+3)-XCOOR(INP1+3)
  266.       XL= SQRT( C(1)*C(1)+C(2)*C(2)+C(3)*C(3))
  267.       C(1)=C(1)/XL
  268.       C(2)=C(2)/XL
  269.       C(3)=C(3)/XL
  270.       IF(JOP.EQ.2) THEN
  271.          D(1)=-C(2)
  272.          D(2)=C(1)
  273.          D(3)=0.D0
  274.          XL=SQRT(D(1)*D(1)+D(2)*D(2)+D(3)*D(3))
  275.          IF(XL.LT.1.D-3) THEN
  276.               D(1)=-C(3)
  277.               D(2)=0D0
  278.               D(3)=C(1)
  279.               XL=SQRT(D(1)*D(1)+D(2)*D(2)+D(3)*D(3))
  280.          ENDIF
  281.          C(1)=D(1)/XL
  282.          C(2)=D(2)/XL
  283.          C(3)=D(3)/XL
  284.       ENDIF
  285.       IF(JOP.EQ.3) THEN
  286.          D(1)=-C(2)
  287.          D(2)=C(1)
  288.          D(3)=0.
  289.          XL=SQRT(D(1)*D(1)+D(2)*D(2)+D(3)*D(3))
  290.          IF(XL.LT.1.D-3) THEN
  291.               D(1)=-C(3)
  292.               D(2)=0.
  293.               D(3)=C(1)
  294.               XL=SQRT(D(1)*D(1)+D(2)*D(2)+D(3)*D(3))
  295.          ENDIF
  296.          D(1)=D(1)/XL
  297.          D(2)=D(2)/XL
  298.          D(3)=D(3)/XL
  299.          E(1)=C(2)*D(3)-C(3)*D(2)
  300.          E(2)=C(3)*D(1)-C(1)*D(3)
  301.          E(3)=C(1)*D(2)-C(2)*D(1)
  302.          C(1)=E(1)
  303.          C(2)=E(2)
  304.          C(3)=E(3)
  305.       ENDIF
  306.       RE(3,1,i)=C(1)
  307.       RE(3,2,i)=C(1)
  308.       RE(1,3,i)=C(1)
  309.       RE(2,3,i)=C(1)
  310.       RE(4,1,i)=C(2)
  311.       RE(4,2,i)=C(2)
  312.       RE(1,4,i)=C(2)
  313.       RE(2,4,i)=C(2)
  314.       IA=4
  315. *      IB=15
  316.       IF(IDIM.EQ.3) THEN
  317.            RE(5,1,i)=C(3)
  318.            RE(5,2,i)=C(3)
  319.            RE(1,5,i)=C(3)
  320.            RE(2,5,i)=C(3)
  321.            IA=5
  322. *           IB=21
  323.       ENDIF
  324.       RE(IA+1,1,i)=-C(1)
  325.       RE(IA+1,2,i)=-C(1)
  326.       RE(1,IA+1,i)=-C(1)
  327.       RE(2,IA+1,i)=-C(1)
  328.       RE(IA+2,1,i)=-C(2)
  329.       RE(IA+2,2,i)=-C(2)
  330.       RE(1,IA+2,i)=-C(2)
  331.       RE(2,IA+2,i)=-C(2)
  332.       IF(IDIM.EQ.3) THEN
  333.           RE(IA+3,1,i)=-C(3)
  334.           RE(IA+3,2,i)=-C(3)
  335.           RE(1,IA+3,i)=-C(3)
  336.           RE(2,IA+3,i)=-C(3)
  337.       ENDIF
  338. *      SEGDES XMATRI
  339. *      IMATTT(I)=XMATRI
  340.    50 CONTINUE
  341.   500 CONTINUE
  342.       SEGDES MELEME,IPT1,IPT2,xMATRI
  343.       SEGDES MRIGID
  344.       SEGSUP ITRA
  345.       CALL ECROBJ('RIGIDITE',MRIGID)
  346.       RETURN
  347.       END
  348.  
  349.  
  350.  
  351.  
  352.  
  353.  
  354.  
  355.  
  356.  

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