Télécharger la plaquette Cast3M


fr en

Télécharger relami.eso

Retour à la liste

Numérotation des lignes : 

relami

  1. C RELAMI    SOURCE    PV        20/03/24    21:21:48     10554          
  2.  
  3.       SUBROUTINE RELAMI
  4.  
  5. C=======================================================================
  6. C CE SOUS-PROGRAMME CONSTRUIT LA RIGIDITE LIANT LINEAIREMENT LES DDL
  7. C DES NOEUDS MILIEUX D'UN MAILLAGE QUADRATIQUE AUX NOEUDS SOMMETS
  8. C
  9. C SYNTHAXE GIBIANE : RIG1 = RELA MILI (LMOTS1) GEO1 ;
  10. C=======================================================================
  11.  
  12. C======================== ZONE DE DECLARATIONS =========================
  13.  
  14.       IMPLICIT INTEGER(I-N)
  15.       IMPLICIT REAL*8 (A-H,O-Z)
  16.  
  17.  
  18. -INC PPARAM
  19. -INC CCOPTIO
  20. -INC CCHAMP
  21. -INC CCGEOME
  22. -INC SMLMOTS
  23. -INC SMCOORD
  24. -INC SMELEME
  25. -INC SMRIGID
  26.  
  27.       CHARACTER*4 LESDDL(10),LESDUA(10)
  28.  
  29.       SEGMENT IMILI(NBDDL)
  30.  
  31. C========================= CORPS DU PROGRAMME ==========================
  32.  
  33. C==== LECTURE DES ARGUMENTS
  34.  
  35.       CALL LIROBJ('LISTMOTS',IP0,0,IRETOU)
  36.       IF (IERR.NE.0) RETURN
  37.  
  38.       CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  39.       IF (IERR.NE.0) RETURN
  40.  
  41. C==== NOMS DES INCONNUES DE LA RIGIDITE
  42.  
  43. C     Si pas de LISTMOTS, je prends le inconnues de la meca.
  44.       IF (IP0.EQ.0) THEN
  45.         IF (IFOUR.LT.0) THEN
  46.           NBDDL=2
  47.           LESDDL(1)='UX  '
  48.           LESDDL(2)='UY  '
  49.           LESDUA(1)='FX  '
  50.           LESDUA(2)='FY  '
  51.         ELSEIF (IFOUR.EQ.0) THEN
  52.           NBDDL=2
  53.           LESDDL(1)='UR  '
  54.           LESDDL(2)='UZ  '
  55.           LESDUA(1)='FR  '
  56.           LESDUA(2)='FZ  '
  57.         ELSEIF (IFOUR.EQ.1) THEN
  58.           NBDDL=3
  59.           LESDDL(1)='UR  '
  60.           LESDDL(2)='UT  '
  61.           LESDDL(3)='UZ  '
  62.           LESDUA(1)='FR  '
  63.           LESDUA(2)='FT  '
  64.           LESDUA(3)='FZ  '
  65.         ELSE
  66.           NBDDL=3
  67.           LESDDL(1)='UX  '
  68.           LESDDL(2)='UY  '
  69.           LESDDL(3)='UZ  '
  70.           LESDUA(1)='FX  '
  71.           LESDUA(2)='FY  '
  72.           LESDUA(3)='FZ  '
  73.         ENDIF
  74.       ELSE
  75. C     Sinon, on prends les DDL specifies et on cherche les duals
  76.         MLMOTS=IP0
  77.         SEGACT,MLMOTS
  78.         NBDDL=MOTS(/2)
  79.         DO I=1,NBDDL
  80.            DO J=1,LNOMDD
  81.              IF (MOTS(I).EQ.NOMDD(J)) THEN
  82.                LESDDL(I)=NOMDD(J)
  83.                LESDUA(I)=NOMDU(J)
  84.              ENDIF
  85.            ENDDO
  86.         ENDDO
  87.         SEGDES,MLMOTS
  88.       ENDIF
  89.  
  90. C==== TRANSFORMATION DU MAILLAGE INI. EN SEGMENTS SI BESOIN
  91.  
  92.       IF (IDIM.GE.2) THEN
  93.         CALL ECROBJ('MAILLAGE',IPT1)
  94.         CALL CHANLG
  95.         IF (IPT1.EQ.0) THEN
  96.           CALL ERREUR(16)
  97.         END IF
  98.         CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  99.         IF (IERR.NE.0) RETURN
  100.       ENDIF
  101.  
  102. C==== CONSTRUCTION DU MAILLAGE SUPPORT DE LA RIGIDITE
  103.  
  104. C     J'initialise un vecteur que je vais remplir de maillages elem.
  105.       SEGINI,IMILI
  106.  
  107.       IDIMP1=IDIM+1
  108. C     Je parcours le maillage ini. et construis les maillages elem.
  109.       SEGACT,IPT1
  110.       NBSOUS1=IPT1.LISOUS(/1)
  111. C     J'ai un maillage simple
  112.       IF (NBSOUS1.EQ.0) THEN
  113.         IF (IPT1.ITYPEL.EQ.3) THEN
  114.           NBEL1=IPT1.NUM(/2)
  115.           segact mcoord*mod
  116.           NBPTI=nbpts
  117.           NBPTS=NBPTI+NBDDL*NBEL1
  118.           SEGADJ,MCOORD
  119.           NBSOUS=0
  120.           NBREF=0
  121.           NBELEM=NBEL1
  122.           NBNN=4
  123.           ICPT1=0
  124.           DO I=1,NBDDL
  125.             SEGINI,IPT2
  126.             IPT2.ITYPEL=22
  127.             DO J=1,NBEL1
  128.               IP=NBPTI+ICPT1+J
  129.               IREF=(IP-1)*IDIMP1
  130.               IREF2=(IPT1.NUM(2,J)-1)*IDIMP1
  131.               DO K=1,IDIMP1
  132.                 XCOOR(IREF+K)=XCOOR(IREF2+K)
  133.               ENDDO
  134.               IPT2.NUM(1,J)=IP
  135.               IPT2.NUM(2,J)=IPT1.NUM(2,J)
  136.               IPT2.NUM(3,J)=IPT1.NUM(1,J)
  137.               IPT2.NUM(4,J)=IPT1.NUM(3,J)
  138.             ENDDO
  139.             SEGDES,IPT2
  140.             IMILI(I)=IPT2
  141.             ICPT1=ICPT1+NBEL1
  142.           ENDDO
  143.         ELSE
  144. C         Si pas de SEG3, ERREUR
  145.           SEGSUP,IMILI
  146.           SEGDES,IPT1
  147.           CALL ERREUR(16)
  148.           RETURN
  149.         ENDIF
  150. C     J'ai un maillage complexe
  151.       ELSE
  152.         NBEL1=0
  153.         DO ISOUS=1,NBSOUS1
  154.           IPT3=IPT1.LISOUS(ISOUS)
  155.           SEGACT,IPT3
  156.           IF (IPT3.ITYPEL.EQ.3) THEN
  157.             NBEL1=NBEL1+IPT3.NUM(/2)
  158.           ENDIF
  159.         ENDDO
  160. C       Si pas de SEG3, ERREUR
  161.         IF (NBEL1.EQ.0) THEN
  162.           SEGSUP,IMILI
  163.           SEGDES,IPT1
  164.           CALL ERREUR(16)
  165.           RETURN
  166.         ENDIF
  167.         segact mcoord*mod
  168.         NBPTI=nbpts
  169.         NBPTS=NBPTI+NBDDL*NBEL1
  170.         SEGADJ,MCOORD
  171.         NBSOUS=0
  172.         NBREF=0
  173.         NBELEM=NBEL1
  174.         NBNN=4
  175.         ICPT1=0
  176.         DO I=1,NBDDL
  177.           ICEL1=0
  178.           SEGINI,IPT2
  179.           IPT2.ITYPEL=22
  180.           DO ISOUS=1,NBSOUS1
  181.             IPT3=IPT1.LISOUS(ISOUS)
  182.             IF (IPT3.ITYPEL.EQ.3) THEN
  183.               NBEL3=IPT3.NUM(/2)
  184.               DO J=1,NBEL3
  185.                 IP=NBPTI+ICPT1+J
  186.                 IREF=(IP-1)*IDIMP1
  187.                 IREF2=(IPT3.NUM(2,J)-1)*IDIMP1
  188.                 DO K=1,IDIMP1
  189.                   XCOOR(IREF+K)=XCOOR(IREF2+K)
  190.                 ENDDO
  191.                 IPT2.NUM(1,ICEL1+J)=IP
  192.                 IPT2.NUM(2,ICEL1+J)=IPT3.NUM(2,J)
  193.                 IPT2.NUM(3,ICEL1+J)=IPT3.NUM(1,J)
  194.                 IPT2.NUM(4,ICEL1+J)=IPT3.NUM(3,J)
  195.               ENDDO
  196.               ICPT1=ICPT1+NBEL3
  197.               ICEL1=ICEL1+NBEL3
  198.             ENDIF
  199.             SEGDES,IPT3
  200.           ENDDO
  201.           SEGDES,IPT2
  202.           IMILI(I)=IPT2
  203.         ENDDO
  204.       ENDIF
  205.       SEGDES,IPT1
  206.  
  207. C==== CONSTRUCTION DE LA RIGIDITE ASSOCIEE AUX RELA.
  208.  
  209.       NRIGEL=NBDDL
  210.       NRIGE=8
  211.       SEGINI,RI1
  212.       RI1.MTYMAT='RIGIDITE'
  213.       RI1.IFORIG=IFOUR
  214.       NLIGRP=4
  215.       NLIGRD=NLIGRP
  216.       DO I=1,NRIGEL
  217. C       On a un segment DESCR par DDL
  218.         SEGINI,DES1
  219.         DES1.LISINC(1)='LX'
  220.         DES1.LISDUA(1)='FLX'
  221.         DES1.NOELEP(1)=1
  222.         DES1.NOELED(1)=1
  223.         DO J=2,4
  224.           DES1.LISINC(J)=LESDDL(I)
  225.           DES1.LISDUA(J)=LESDUA(I)
  226.           DES1.NOELEP(J)=J
  227.           DES1.NOELED(J)=J
  228.         ENDDO
  229.         SEGDES,DES1
  230. C       On a un segment XMATRI par DDL
  231.         nelrig=nbel1
  232.         SEGINI,XMATR1
  233.         XMATR1.RE(1,2,1)=1.
  234.         XMATR1.RE(1,3,1)=-0.5
  235.         XMATR1.RE(1,4,1)=-0.5
  236.         XMATR1.RE(2,1,1)=XMATR1.RE(1,2,1)
  237.         XMATR1.RE(3,1,1)=XMATR1.RE(1,3,1)
  238.         XMATR1.RE(4,1,1)=XMATR1.RE(1,4,1)
  239. *        SEGDES,XMATR1
  240. C       On a NBEL1 matrice(s) elementaire(s)
  241.         do ioup=2,nelrig
  242.            do io=1,xmatr1.re(/2)
  243.               do iu=1,xmatr1.re(/1)
  244.                  xmatr1.re(iu,io,ioup)=xmatr1.re(iu,io,1)
  245.                enddo
  246.            enddo
  247.         enddo
  248. *        NELRIG=NBEL1
  249. *        SEGINI,IMATR1
  250. *        DO J=1,NELRIG
  251. *          IMATR1.IMATTT(J)=XMATR1
  252. *        ENDDO
  253.         SEGDES,xMATR1
  254. C       On remplit la rigidite
  255.         RI1.COERIG(I)=1.
  256.         RI1.IRIGEL(1,I)=IMILI(I)
  257.         RI1.IRIGEL(2,I)=0
  258.         RI1.IRIGEL(3,I)=DES1
  259.         RI1.IRIGEL(4,I)=xMATR1
  260.         RI1.IRIGEL(5,I)=NIFOUR
  261.         RI1.IRIGEL(6,I)=0
  262.         RI1.IRIGEL(7,I)=0
  263.         RI1.IRIGEL(8,I)=0
  264.       ENDDO
  265.       SEGDES,RI1
  266.       IPRIG=RI1
  267.       SEGSUP IMILI
  268.  
  269. C==== JE SORS LA RIGIDITE
  270.  
  271.       CALL ECROBJ('RIGIDITE',IPRIG)
  272.  
  273.       RETURN
  274.       END
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  

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