Télécharger la plaquette Cast3M


fr en

Télécharger appui.eso

Retour à la liste

Numérotation des lignes : 

appui

  1. C APPUI     SOURCE    FANDEUR   22/01/03    21:15:03     11237          
  2.  
  3. C=======================================================================
  4. C=                             A P P U I                               =
  5. C=                             ---------                               =
  6. C=                                                                     =
  7. C=  OPERATEUR CAST3M 'APPUI' :                                         =
  8. C=  --------------------------                                         =
  9. C=   RIG1  =  'APPUI'  |  MOT1 ... MOTn  |  RAI1  MAI1  ;              =
  10. C=                     |  'DEPL'         |                             =
  11. C=                     |  'ROTA'         |                             =
  12. C=   Cet operateur fabrique des appuis (ressort de raideur RAI1) ou    =
  13. C=   des masses additionnelles (de valeur RAI1) en un point ou sur     =
  14. C=   tous les points d'un maillage et pour un ou plusieurs ddl.        =
  15. C=                                                                     =
  16. C=  ARGUMENTS :                                                        =
  17. C=  -----------                                                        =
  18. C=   MAI1   (MAILLAGE/POINT)   Lieu d'application du ressort/masse     =
  19. C=   RAI1         (FLOTTANT)   Valeur de la raideur/masse              =
  20. C=   MOT1...MOTn       (MOT)   DDL concernes par le ressort/masse      =
  21. C=   Le mot 'DEPL' (resp. 'ROTA') indique que tous les ddls de depla-  =
  22. C=   cement (resp. rotation) sont concernes par le ressort/masse.      =
  23. C=                                                                     =
  24. C=  RESULTAT :                                                         =
  25. C=  ----------                                                         =
  26. C=   RIG1         (RIGIDITE)   Rigidite associee aux appuis/masses     =
  27. C=======================================================================
  28.  
  29.       SUBROUTINE APPUI (IMILL)
  30.  
  31.       IMPLICIT INTEGER(I-N)
  32.       IMPLICIT REAL*8 (A-H,O-Z)
  33.  
  34.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37. -INC CCHAMP
  38. -INC SMELEME
  39. -INC SMCOORD
  40. -INC SMRIGID
  41.  
  42.       SEGMENT MSWBLO
  43.         CHARACTER*4 MOTDDL(0)
  44.       ENDSEGMENT
  45.  
  46.       DIMENSION XNOR(3),U1(3),U2(3)
  47.  
  48.       CHARACTER*4 MOTBLO(4)
  49.       CHARACTER*4 MODEPL(6),MODEDU(6)
  50.       CHARACTER*4 MORODU(5),MOROTA(5)
  51.       CHARACTER*4 MODE1D(2),MOFO1D(2)
  52.  
  53.       DATA EPSI / 1.D-12 /
  54.       DATA LMOBLO / 4 /
  55.       DATA MOTBLO / 'DEPL','ROTA','RADI','DIRE' /
  56.       DATA MODEPL / 'UX  ','UY  ','UZ  ','UR  ','UZ  ','UT  ' /
  57.       DATA MODEDU / 'FX  ','FY  ','FZ  ','FR  ','FZ  ','FT  ' /
  58.       DATA MOROTA / 'RX  ','RY  ','RZ  ','RT  ','RS  ' /
  59.       DATA MORODU / 'MX  ','MY  ','MZ  ','MT  ','MS  ' /
  60. C Tableaux MODE1D et MOFO1D sont utilises pour certains modes 1D
  61.       DATA MODE1D / 'UX  ','UZ  ' /
  62.       DATA MOFO1D / 'FX  ','FZ  ' /
  63.  
  64. C  Quelques initialisations selon le type de probleme
  65.       idimp1=IDIM+1
  66. C  Cas IDIM = 1 :
  67. C  ISPE1D = 1 si IDIM=1 et IFOUR=9 ou 10, car les noms de DDL primaux et
  68. C  variables duales ne sont pas dans l'ordre "classique" (un traitement
  69. C  specifique est alors necessaire).
  70.       ISPE1D=0
  71. C  Deformations planes ou contraintes planes ou defo. plane gene :
  72.       IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  73.         LDEPL=2
  74.         IADEPL=0
  75.         LROTA=1
  76.         IAROTA=2
  77. C  Axisymetrique :
  78.       ELSE IF (IFOUR.EQ.0) THEN
  79.         LDEPL=2
  80.         IADEPL=3
  81.         LROTA=1
  82.         IAROTA=3
  83. C  Fourier :
  84.       ELSE IF (IFOUR.EQ.1) THEN
  85.         LDEPL=3
  86.         IADEPL=3
  87.         LROTA=1
  88.         IAROTA=3
  89. C  Tridimensionnel :
  90.       ELSE IF (IFOUR.EQ.2) THEN
  91.         LDEPL=3
  92.         LROTA=3
  93.         IADEPL=0
  94.         IAROTA=0
  95. C  Massif 1D (IDIM=1) :
  96.       ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN
  97.         IF (IFOUR.LE.6) THEN
  98.           LDEPL=1
  99.           IADEPL=0
  100.         ELSE IF (IFOUR.GE.7.AND.IFOUR.LE.10) THEN
  101.           LDEPL=2
  102.           IADEPL=0
  103.           IF (IFOUR.EQ.9.OR.IFOUR.EQ.10) ISPE1D=1
  104.         ELSE IF (IFOUR.EQ.11) THEN
  105.           LDEPL=3
  106.           IADEPL=0
  107.         ELSE IF (IFOUR.EQ.15) THEN
  108.           LDEPL=2
  109.           IADEPL=3
  110.         ELSE
  111.           LDEPL=1
  112.           IADEPL=3
  113.         ENDIF
  114.         LROTA=0
  115.         IAROTA=0
  116. C  Autres cas :
  117.       ELSE
  118.         LDEPL=0
  119.         IADEPL=0
  120.         LROTA=0
  121.         IAROTA=0
  122.       ENDIF
  123.  
  124. C  Initialisation de la liste des ddls MOTDDL (segment MSWBLO)
  125.       SEGINI,MSWBLO
  126.  
  127. C-----------------------------------------------------------------------
  128. C  Lecture eventuelle des MOTS autres que des DDLS
  129. C-----------------------------------------------------------------------
  130. C  Lecture eventuelle de 'DEPL' et/ou 'ROTA'
  131. C --------------------
  132.       IDEPL=0
  133.       IROTA=0
  134.  481  CALL LIRMOT(MOTBLO,2,IMOT,0)
  135.       IF (IMOT.EQ.1) IDEPL=1
  136.       IF (IMOT.EQ.2) IROTA=1
  137.       IF (IMOT.NE.0) GOTO 481
  138. C  Lecture eventuelle de 'RADI' ou 'DIRE'
  139. C --------------------
  140.       IRADIA=0
  141.       IDIREC=0
  142.  4480 CALL LIRMOT(MOTBLO(3),2,IMOT,0)
  143.       IF (IMOT.EQ.0) THEN
  144.         IF (IDEPL.EQ.1) GOTO 44801
  145.         IF (IROTA.EQ.1) GOTO 44802
  146.         IBDDL=MOTDDL(/2)
  147.         IF (IBDDL.NE.0) GOTO 449
  148.         IF (IBDDL.EQ.0) GOTO 445
  149.       ENDIF
  150. C  En DIMENSION 1, les mots-cles 'RADI' et 'DIRE' sont interdits.
  151.       IF (IDIM.EQ.1) THEN
  152.         INTERR(1)=IDIM
  153.         MOTERR(1:4)=MOTBLO(2+IMOT)
  154.         CALL ERREUR(971)
  155.         GOTO 100
  156.       ENDIF
  157.       GOTO (44803,44804),IMOT
  158. C  Traitement des mots-cles : Mise a jour de MOTDDL
  159. C ----------------------------
  160. C  On a trouve le mot DEPLAcement
  161. 44801 IDEPL=0
  162. C  Cas particulier pour certains modes de IDIM=1
  163.       IF (ISPE1D.EQ.1) THEN
  164.         DO i=1,LDEPL
  165.           MOTDDL(**)=MODE1D(IADEPL+i)
  166.           MOTDDL(**)=MOFO1D(IADEPL+i)
  167.         ENDDO
  168. C  Cas general
  169.       ELSE
  170.         DO i=1,LDEPL
  171.           MOTDDL(**)=MODEPL(IADEPL+i)
  172.           MOTDDL(**)=MODEDU(IADEPL+i)
  173.         ENDDO
  174.       ENDIF
  175.       GOTO 4480
  176. C  On a trouve le mot ROTAtion
  177. 44802 IROTA=0
  178.       DO i=1,LROTA
  179.         MOTDDL(**)=MOROTA(IAROTA+i)
  180.         MOTDDL(**)=MORODU(IAROTA+i)
  181.       ENDDO
  182.       GOTO 4480
  183. C  On a trouve le mot RADial
  184. 44803 IRADIA=1
  185.       CALL LIROBJ('POINT',KPOINT,1,IRETOU)
  186.       IF (IRETOU.EQ.0) GOTO 100
  187.       j=(KPOINT-1)*idimp1
  188.       DO i=1,IDIM
  189.         U1(i)=XCOOR(j+i)
  190.       ENDDO
  191. C  Lecture du 2nd point de l'axe (en 3D)
  192.       IF (IDIM.EQ.3) THEN
  193.         CALL LIROBJ('POINT',KPOINT,1,IRETOU)
  194.         IF (IRETOU.EQ.0) GOTO 100
  195.         j=(KPOINT-1)*idimp1
  196.         YL=0.
  197.         DO i=1,IDIM
  198.           U2(i)=XCOOR(j+i)-U1(i)
  199.           YL=YL+U2(i)*U2(i)
  200.         ENDDO
  201. C  Calcul du vecteur directeur unitaire de l'axe (U2)
  202.         IF (YL.LT.EPSI) THEN
  203.           CALL ERREUR(237)
  204.           GOTO 100
  205.         ENDIF
  206.         YL=1./SQRT(YL)
  207.         DO i=1,IDIM
  208.           U2(i)=U2(i)*YL
  209.         ENDDO
  210.       ENDIF
  211.       GOTO 449
  212. C  On a trouve le mot DIREction
  213. 44804 IDIREC=1
  214.       CALL LIROBJ('POINT',KPOINT,1,IRETOU)
  215.       IF (IRETOU.EQ.0) GOTO 100
  216.       j=(KPOINT-1)*idimp1
  217.       YL=0.
  218.       DO i=1,IDIM
  219.         XNOR(i)=XCOOR(j+i)
  220.         YL=YL+XNOR(i)*XNOR(i)
  221.       ENDDO
  222.       IF (YL.LT.EPSI) THEN
  223.         CALL ERREUR(239)
  224.         GOTO 100
  225.       ENDIF
  226.       YL=1./SQRT(YL)
  227.       DO i=1,IDIM
  228.         XNOR(i)=XNOR(i)*YL
  229.       ENDDO
  230.       GOTO 449
  231.  
  232. C  Lecture eventuelle de DDLs :
  233. C ------------------------------
  234. C  La liste des ddls autorises NOMDD est dans BDATA.ESO
  235. C  On doit lire au moins 1 ddl (car sinon MOTDDL est vide !)
  236.  445  LACOND=1
  237.       LMOT=9
  238.  446  CALL LIRMOT(NOMDD,LMOT,IMOT,LACOND)
  239.       IF (IERR.NE.0) GOTO 100
  240.       IF (IMOT.EQ.0) GOTO 449
  241.       MOTDDL(**)=NOMDD(IMOT)
  242.       MOTDDL(**)=NOMDU(IMOT)
  243.       LACOND=0
  244.       GOTO 446
  245.  
  246.  449  IBDDL=MOTDDL(/2)
  247. C  Verification que le nombre de DDLs a bloquer n'est pas nul
  248. C     IF (IBDDL.EQ.0) GOTO 100
  249. C-----------------------------------------------------------------------
  250. C  Fin de la lecture des mots (DEPL,ROTA...) ou des DDLs
  251. C-----------------------------------------------------------------------
  252.  
  253. C  Recherche du maillage MELEME de type POINT :
  254. C ----------------------------------------------
  255. C  On cherche d'abord si on a un POINT que l'on transformera en POI1
  256. C  sinon on cherche un maillage que l'on transforme en POI1 si besoin
  257.       CALL LIROBJ('POINT',KPOINT,0,IRETOU)
  258.       IF (IRETOU.EQ.0) THEN
  259.         CALL LIROBJ('MAILLAGE',KOBJET,1,IRETOU)
  260.         IF (IRETOU.EQ.0) GOTO 100
  261.         MELEME=KOBJET
  262.         SEGACT,MELEME
  263.         IF (ITYPEL.NE.1) CALL CHANGE(MELEME,1)
  264.         NBPOIN=NUM(/2)
  265.       ELSE
  266. C  On pourrait faire appel a CRELEM(KPOINT)
  267.         NBNN=1
  268.         NBELEM=1
  269.         NBREF=0
  270.         NBSOUS=0
  271.         SEGINI,MELEME
  272.         ITYPEL=1
  273.         NUM(1,1)=KPOINT
  274.         NBPOIN=1
  275.       ENDIF
  276.  
  277. C  LECTURE DE LA RAIDEUR DU RESSORT (FLOTTANT)
  278. C -------------------------------------------
  279.       CALL LIRREE(RIG,1,IRETOU)
  280.       IF (IERR.NE.0) GOTO 110
  281.  
  282. C  Determination du nombre de multiplicateurs NNMAT par noeud de MELEME
  283. C  NNMAT correspond au nombre de DDLs a bloquer par noeud = nombre de
  284. C  multiplicateurs a creer par noeud (1 multiplicateur) = NRIGEL
  285. C  Dans les cas RADIal et DIREction, on a une seule matrice par noeud.
  286. C  Dans les autres cas, autant de matrices que MOTDDL(/1)/2.
  287.       NNMAT=1
  288.       IF (IDIREC+IRADIA.EQ.0) NNMAT=IBDDL/2
  289.  
  290. C  Initialisation de l'objet RIGIDITE associe aux BLOCAGES
  291.       NRIGE=8
  292.       NRIGEL=NNMAT
  293.       SEGINI,MRIGID
  294.       IFORIG=IFOUR
  295.       IF (IMILL.EQ.1) THEN
  296.         MTYMAT='RIGIDITE'
  297.       ELSE IF (IMILL.EQ.2) THEN
  298.         MTYMAT='MASSE'
  299.       ENDIF
  300.       ICHOLE=0
  301.       IMGEO1=0
  302.       IMGEO2=0
  303.       KRIGI=MRIGID
  304.  
  305. C Boucle sur le nombre de DDLs a bloquer
  306.       DO IAA=1,NNMAT
  307. C  Creation des RAIDEURS associees au IAA-eme multplicateur (DDL)
  308.         IRIGEL(1,IAA)=MELEME
  309.         IRIGEL(2,IAA)=0
  310.         IRIGEL(5,IAA)=NIFOUR
  311.         IRIGEL(6,IAA)=0
  312. C**     IRIGEL(7,IAA)=0
  313. C**     IRIGEL(8,IAA)=0
  314. C  Remplissage du tableau des DESCripteurs de RIG
  315.         NLIGRP=1
  316.         IF (IDIREC+IRADIA.NE.0) NLIGRP=LDEPL
  317.         NLIGRD=NLIGRP
  318.         SEGINI,DESCR
  319.         IRIGEL(3,IAA)=DESCR
  320.         IF (IDIREC+IRADIA.EQ.0) THEN
  321.           NOELEP(1)=1
  322.           NOELED(1)=1
  323.           j=2*(IAA-1)
  324.           LISINC(1)=MOTDDL(j+1)
  325.           LISDUA(1)=MOTDDL(j+2)
  326.         ELSE
  327.           DO i=1,LDEPL
  328.             NOELEP(i)=1
  329.             NOELED(i)=1
  330.             IF (IROTA.NE.1) THEN
  331.               LISINC(i)=MODEPL(i+IADEPL)
  332.               LISDUA(i)=MODEDU(i+IADEPL)
  333.             ELSE
  334.               LISINC(i)=MOROTA(i+IADEPL)
  335.               LISDUA(i)=MORODU(i+IADEPL)
  336.             ENDIF
  337.           ENDDO
  338.         ENDIF
  339.         SEGDES,DESCR
  340. C**     NLIGRP=1
  341. C**     IF (IDIREC+IRADIA.NE.0) NLIGRP=IDIM
  342. C**     NLIGRD=NLIGRP
  343.         NELRIG=NBPOIN
  344.         SEGINI,xMATRI
  345.         IRIGEL(4,IAA)=xMATRI
  346.         COERIG(IAA)=1.
  347.  
  348. C  Remplissage de  la matrice de rigidite RE :
  349. C  Il faut distinguer les cas IRADIA et IDIREC
  350. C  IRADIA : Il faut calculer la DIREction puis identique a IDIREC
  351. C  IDIREC : La DIRECTION est stockee dans le vecteur norme XNOR
  352. C  AUTRES : La matrice est predefinie dans RIG
  353. C  Option RADIAL : Calcul prealable de la direction pour chaque noeud
  354.         IF (IRADIA.EQ.1) THEN
  355.           DO IB=1,NBPOIN
  356.             j=(NUM(1,IB)-1)*idimp1
  357.             DO i=1,IDIM
  358.               XNOR(i)=XCOOR(j+i)-U1(i)
  359.             ENDDO
  360.             IF (IDIM.EQ.2) THEN
  361.               YL=XNOR(1)*XNOR(1)+XNOR(2)*XNOR(2)
  362.               IF (YL.LT.EPSI) THEN
  363.                 CALL ERREUR(238)
  364.                 GOTO 110
  365.               ENDIF
  366.               YL=1./SQRT(YL)
  367.               XNOR(1)=XNOR(1)*YL
  368.               XNOR(2)=XNOR(2)*YL
  369.             ELSE
  370.               YL=XNOR(1)*U2(1)+XNOR(2)*U2(2)+XNOR(3)*U2(3)
  371.               XL=0.
  372.               DO i=1,3
  373.                 XNOR(i)=XNOR(i)-YL*U2(i)
  374.                 XL=XL+XNOR(i)*XNOR(i)
  375.               ENDDO
  376.               IF (XL.LT.EPSI) THEN
  377.                 CALL ERREUR(238)
  378.                 GOTO 110
  379.               ENDIF
  380.               XL=1./SQRT(XL)
  381.               XNOR(1)=XNOR(1)*XL
  382.               XNOR(2)=XNOR(2)*XL
  383.               XNOR(3)=XNOR(3)*XL
  384.             ENDIF
  385. C  XNOR contient la direction normee
  386. *            SEGINI,XMATRI
  387. *            IMATTT(IB)=XMATRI
  388.             RE(1,1,ib)=RIG*XNOR(1)*XNOR(1)
  389.             RE(2,1,ib)=RIG*XNOR(1)*XNOR(2)
  390.             RE(1,2,ib)=RE(2,1,ib)
  391.             RE(2,2,ib)=RIG*XNOR(2)*XNOR(2)
  392.             IF (IDIM.EQ.3) THEN
  393.               RE(1,3,ib)=RIG*XNOR(1)*XNOR(3)
  394.               RE(3,1,ib)=RE(1,3,ib)
  395.               RE(2,3,ib)=RIG*XNOR(2)*XNOR(3)
  396.               RE(3,2,ib)=RE(2,3,ib)
  397.               RE(3,3,ib)=RIG*XNOR(3)*XNOR(3)
  398.             ENDIF
  399. *            SEGDES,XMATRI
  400.           ENDDO
  401.           SEGDES,xMATRI
  402. C  Option DIRECTION
  403.         ELSE IF (IDIREC.EQ.1) THEN
  404. *          SEGINI,XMATRI
  405.           RE(1,1,1)=RIG*XNOR(1)*XNOR(1)
  406.           RE(2,1,1)=RIG*XNOR(1)*XNOR(2)
  407.           RE(1,2,1)=RE(2,1,1)
  408.           RE(2,2,1)=RIG*XNOR(2)*XNOR(2)
  409.           IF (IDIM.EQ.3) THEN
  410.             RE(1,3,1)=RIG*XNOR(1)*XNOR(3)
  411.             RE(3,1,1)=RE(1,3,1)
  412.             RE(2,3,1)=RIG*XNOR(2)*XNOR(3)
  413.             RE(3,2,1)=RE(2,3,1)
  414.             RE(3,3,1)=RIG*XNOR(3)*XNOR(3)
  415.           ENDIF
  416.           DO i=2,NBPOIN
  417.              do io=1,re(/2)
  418.                do iu=1,re(/1)
  419.                  re(iu,io,i)=re(iu,io,1)
  420.                enddo
  421.              enddo
  422.           ENDDO
  423.           SEGDES,XMATRI
  424. *          SEGDES,IMATRI
  425. C  Autres options :
  426.         ELSE
  427. *          SEGINI,XMATRI
  428. *          IXMATR=XMATRI
  429. *          RE(1,1)=RIG
  430. *          SEGDES,XMATRI
  431.           DO i=1,NBPOIN
  432.             RE(1,1,i)=RIG
  433. *            IMATTT(i)=IXMATR
  434.           ENDDO
  435.           SEGDES,xMATRI
  436.         ENDIF
  437.       ENDDO
  438. C  Fin de la boucle sur les IAA DDLs a bloquer
  439.  
  440.       SEGDES,MRIGID
  441.       CALL ECROBJ('RIGIDITE',KRIGI)
  442.  
  443.  110  SEGDES,MELEME
  444.  100  SEGSUP,MSWBLO
  445.  
  446.       RETURN
  447.       END
  448.  
  449.  
  450.  
  451.  
  452.  
  453.  
  454.  
  455.  
  456.  
  457.  

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