Télécharger la plaquette Cast3M


fr en

Télécharger symtri.eso

Retour à la liste

Numérotation des lignes : 

symtri

  1. C SYMTRI    SOURCE    PV        20/04/01    21:16:39     10569          
  2.  
  3. C  Creation des (matrices de) RIGIDITE associees a des conditions de
  4. C  SYMETRIE (operateur SYMT) et d'ANTISYMETRIE (operateur ANTI).
  5.  
  6. C  Syntaxe :  SYMT ('DEPL')('ROTA') MELEME P1 (P2) (P3) (FLOT1) ;
  7. C             ANTI ('DEPL')('ROTA') MELEME P1 (P2) (P3) (FLOT1) ;
  8.  
  9. C  10/2003 : modifications pour integrer cas IDIM=1.
  10. C  En dimension 1, ces operateurs ne sont pas disponibles.
  11. C  L'utilisation de l'operateur BLOQUE est suffisante !
  12.  
  13.       SUBROUTINE SYMTRI(ityp)
  14.  
  15.       IMPLICIT INTEGER(I-N)
  16.       IMPLICIT REAL*8 (A-H,O-Z)
  17.  
  18.  
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC SMCOORD
  23.  
  24. C**   DIMENSION XNORM(3)
  25.       COMMON / CSYMTR / XNORM(3)
  26.  
  27.       DIMENSION U1(3),U2(3)
  28.       CHARACTER*4 MOTBLO(2)
  29.       DATA MOTBLO / 'DEPL','ROTA' /
  30.  
  31. C  Operateurs SYMT et ANTI indisponibles en dimension 1
  32.       IF (IDIM.EQ.1) THEN
  33.         INTERR(1)=IDIM
  34.         CALL ERREUR(709)
  35.         RETURN
  36.       ENDIF
  37.  
  38.       idimp1=IDIM+1
  39. C  Signification de ITYP :
  40. C  ITYP = 0 si operateur SYMT , ITYP = 1 si operateur ANTI
  41.  
  42. C  Lecture de DEPL ou ROTA pour permettre la lecture de la suite
  43. C  Signification de IDEPL et IROTA :
  44. C  IDEPL=1 (IROTA=1) si mot-cle 'DEPL' ('ROTA') active et =0 sinon
  45.       IDEPL=0
  46.       IROTA=0
  47.       CALL LIRMOT(MOTBLO,2,IMOT,1)
  48.       IF (IERR.NE.0) RETURN
  49.   10  IF (IMOT.EQ.1) IDEPL=1
  50.       IF (IMOT.EQ.2) IROTA=1
  51.       CALL LIRMOT(MOTBLO,2,IMOT,0)
  52.       IF (IMOT.NE.0) GOTO 10
  53.  
  54. C  Appel a POIEXT pour recuperer le bon ensemble de POINTS
  55.       IF (IDIM.EQ.2) THEN
  56.         CALL ECRCHA('DROI')
  57.       ELSE
  58.         CALL ECRCHA('PLAN')
  59.       ENDIF
  60.       CALL POIEXT
  61. C  En 2D et 3D, lecture de l'ensemble des points, ecrit dans la pile
  62. C  suite a l'appel a POIEXT, soumis a la  condition de (anti)symetrie.
  63.       CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)
  64.       IF (IERR.NE.0) RETURN
  65. C  On construit U1 et U2 perpendiculaires a XNORM (COMMON CSYMTR)
  66. C  Attention en DIME 2 : XNORM est le vecteur directeur de la droite
  67. C  Ces vecteurs U1 et U2 sont utilises dans le cas IROTA=1.
  68.       IF (IDIM.EQ.2) THEN
  69.         XTEMP=-XNORM(2)
  70.         XNORM(2)=XNORM(1)
  71.         XNORM(1)=XTEMP
  72.       ENDIF
  73.       U1(1)=-XNORM(2)
  74.       U1(2)=XNORM(1)
  75.       U1(3)=0.D0
  76.       SU1=SQRT(U1(1)**2+U1(2)**2)
  77.       IF (SU1.GE.0.1) THEN
  78.         U1(1)=U1(1)/SU1
  79.         U1(2)=U1(2)/SU1
  80.       ELSE
  81.         U1(1)=0.D0
  82.         U1(2)=-XNORM(3)
  83.         U1(3)=XNORM(2)
  84.         SU1=SQRT(U1(2)**2+U1(3)**2)
  85.         U1(2)=U1(2)/SU1
  86.         U1(3)=U1(3)/SU1
  87.       ENDIF
  88.       U2(1)=XNORM(2)*U1(3)-XNORM(3)*U1(2)
  89.       U2(2)=XNORM(3)*U1(1)-XNORM(1)*U1(3)
  90.       U2(3)=XNORM(1)*U1(2)-XNORM(2)*U1(1)
  91.  
  92.       IF (ITYP.EQ.1) GOTO 500
  93. C  CONDITION DE SYMETRIE :
  94. C -------------------------
  95. C  Cas 'DEPL' : creation du point associe a la "direction"
  96.       IF (IDEPL.EQ.1) THEN
  97.         segact mcoord*mod
  98.         NBPTS=nbpts+1
  99.         SEGADJ MCOORD
  100.         IPoin=(NBPTS-1)*idimp1
  101.         XCOOR(IPoin+1)=XNORM(1)
  102.         XCOOR(IPoin+2)=XNORM(2)
  103.         IF (IDIM.EQ.3) XCOOR(IPoin+3)=XNORM(3)
  104.         XCOOR(IPoin+idimp1)=0.
  105. C  Appel a BLOQU 'DEPL' 'DIRE' Poin1
  106.         CALL ECROBJ('POINT   ',NBPTS)
  107.         CALL ECRCHA('DIRE')
  108.         CALL ECRCHA('DEPL')
  109.         CALL ECROBJ('MAILLAGE',MELEME)
  110.         CALL BLOQUE
  111.         SEGACT MCOORD*mod
  112.       ENDIF
  113. C  Cas 'ROTA' : creation des points associes a la "direction"
  114. C  En 2D, on fait seulement BLOQUER 'ROTA'
  115.       IF (IROTA.EQ.1) THEN
  116.         IF (IDIM.EQ.2) THEN
  117.           CALL ECRCHA('ROTA')
  118.           CALL ECROBJ('MAILLAGE',MELEME)
  119.           CALL BLOQUE
  120.           SEGACT MCOORD*MOD
  121.         ELSE
  122.           NBPTA=nbpts
  123.           NBPTS=NBPTA+2
  124.           SEGADJ MCOORD
  125.           XCOOR(NBPTA*idimp1+1)=U1(1)
  126.           XCOOR(NBPTA*idimp1+2)=U1(2)
  127.           XCOOR(NBPTA*idimp1+3)=U1(3)
  128.           XCOOR((NBPTA+1)*idimp1)=0.D0
  129.           NBPTA=NBPTA+1
  130. C Appel a BLOQU 'ROTA' 'DIRE' Poin1
  131.           CALL ECROBJ('POINT   ',NBPTA)
  132.           CALL ECRCHA('DIRE')
  133.           CALL ECRCHA('ROTA')
  134.           CALL ECROBJ('MAILLAGE',MELEME)
  135.           CALL BLOQUE
  136.           SEGACT MCOORD*MOD
  137.           XCOOR(NBPTA*idimp1+1)=U2(1)
  138.           XCOOR(NBPTA*idimp1+2)=U2(2)
  139.           XCOOR(NBPTA*idimp1+3)=U2(3)
  140.           XCOOR((NBPTA+1)*idimp1)=0.D0
  141.           NBPTA=NBPTA+1
  142. C  Appel a BLOQU 'ROTA' 'DIRE' Poin1
  143.           CALL ECROBJ('POINT   ',NBPTA)
  144.           CALL ECRCHA('DIRE')
  145.           CALL ECRCHA('ROTA')
  146.           CALL ECROBJ('MAILLAGE',MELEME)
  147.           CALL BLOQUE
  148.           SEGACT MCOORD*MOD
  149.           CALL PRFUSE
  150.         ENDIF
  151.       ENDIF
  152.       IF (IROTA.EQ.1.AND.IDEPL.EQ.1) CALL PRFUSE
  153.       RETURN
  154.  
  155. C  CONDITION D'ANTISYMETRIE :
  156. C ----------------------------
  157. C  Cas 'ROTA' : Creation du point associe a la direction
  158.  500  IF (IROTA.EQ.1) THEN
  159.         segact mcoord*mod
  160.         NBPTS=nbpts+1
  161.         SEGADJ MCOORD
  162.         IPoin=(NBPTS-1)*idimp1
  163.         XCOOR(IPoin+1)=XNORM(1)
  164.         XCOOR(IPoin+2)=XNORM(2)
  165.         IF (IDIM.EQ.3) XCOOR(IPoin+3)=XNORM(3)
  166.         XCOOR(IPoin+idimp1)=0.
  167. C  Appel a BLOQU 'ROTA' 'DIRE'
  168.         IF (IDIM.EQ.3) THEN
  169.           CALL ECROBJ('POINT   ',NBPTS)
  170.           CALL ECRCHA('DIRE')
  171.         ENDIF
  172.         CALL ECRCHA('ROTA')
  173.         CALL ECROBJ('MAILLAGE',MELEME)
  174.         CALL BLOQUE
  175.         SEGACT MCOORD*MOD
  176.       ENDIF
  177. C  Cas 'DEPL' : creation des points associes a la "direction"
  178.       IF (IDEPL.EQ.1) THEN
  179.         IF (IDIM.EQ.3) THEN
  180.           NBPTA=nbpts 
  181.           NBPTS=NBPTA+2
  182.           SEGADJ MCOORD
  183.           XCOOR(NBPTA*idimp1+1)=U1(1)
  184.           XCOOR(NBPTA*idimp1+2)=U1(2)
  185.           XCOOR(NBPTA*idimp1+3)=U1(3)
  186.           XCOOR((NBPTA+1)*idimp1)=0.D0
  187.           NBPTA=NBPTA+1
  188. C  Appel a BLOQU 'DEPL' 'DIRE' Poin1 ;
  189.           CALL ECROBJ('POINT   ',NBPTA)
  190.           CALL ECRCHA('DIRE')
  191.           CALL ECRCHA('DEPL')
  192.           CALL ECROBJ('MAILLAGE',MELEME)
  193.           CALL BLOQUE
  194.           SEGACT MCOORD*MOD
  195.           XCOOR(NBPTA*idimp1+1)=U2(1)
  196.           XCOOR(NBPTA*idimp1+2)=U2(2)
  197.           XCOOR(NBPTA*idimp1+3)=U2(3)
  198.           XCOOR((NBPTA+1)*idimp1)=0.
  199.           NBPTA=NBPTA+1
  200. C  Appel a BLOQU 'DEPL' 'DIRE' Poin1 ;
  201.           CALL ECROBJ('POINT   ',NBPTA)
  202.           CALL ECRCHA('DIRE')
  203.           CALL ECRCHA('DEPL')
  204.           CALL ECROBJ('MAILLAGE',MELEME)
  205.           CALL BLOQUE
  206.           SEGACT MCOORD*MOD
  207.           CALL PRFUSE
  208. C  En 2D, appel a BLOQU 'DEPL' 'DIRE' Poin1 ;
  209.         ELSE
  210.           SEGACT MCOORD*MOD
  211.           NBPTA=nbpts
  212.           NBPTS=NBPTA+1
  213.           SEGADJ MCOORD
  214.           XCOOR(NBPTA*idimp1+1)=U1(1)
  215.           XCOOR(NBPTA*idimp1+2)=U1(2)
  216. C**       XCOOR(NBPTA*idimp1+3)=U1(3)
  217.           XCOOR((NBPTA+1)*idimp1)=0.D0
  218. C**       NBPTA=NBPTA+1
  219.           CALL ECROBJ('POINT   ',NBPTS)
  220.           CALL ECRCHA('DIRE')
  221.           CALL ECRCHA('DEPL')
  222.           CALL ECROBJ('MAILLAGE',MELEME)
  223.           CALL BLOQUE
  224.           SEGACT MCOORD*MOD
  225.         ENDIF
  226.       ENDIF
  227.       IF (IROTA.EQ.1.AND.IDEPL.EQ.1) CALL PRFUSE
  228.       RETURN
  229.  
  230.       END
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  

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