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

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