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  25/11/21    21:15:01     12403          
  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.         SEGINI,xMATRI
  346.         IRIGEL(4,IAA)=xMATRI
  347.         COERIG(IAA)=1.
  348.  
  349. C  Remplissage de  la matrice de rigidite RE :
  350. C  Il faut distinguer les cas IRADIA et IDIREC
  351. C  IRADIA : Il faut calculer la DIREction puis identique a IDIREC
  352. C  IDIREC : La DIRECTION est stockee dans le vecteur norme XNOR
  353. C  AUTRES : La matrice est predefinie dans RIG
  354. C  Option RADIAL : Calcul prealable de la direction pour chaque noeud
  355.         IF (IRADIA.EQ.1) THEN
  356.           DO IB=1,NBPOIN
  357.             j=(NUM(1,IB)-1)*idimp1
  358.             DO i=1,IDIM
  359.               XNOR(i)=XCOOR(j+i)-U1(i)
  360.             ENDDO
  361.             IF (IDIM.EQ.2) THEN
  362.               YL=XNOR(1)*XNOR(1)+XNOR(2)*XNOR(2)
  363.               IF (YL.LT.EPSI) THEN
  364.                 CALL ERREUR(238)
  365.                 GOTO 110
  366.               ENDIF
  367.               YL=1./SQRT(YL)
  368.               XNOR(1)=XNOR(1)*YL
  369.               XNOR(2)=XNOR(2)*YL
  370.             ELSE
  371.               YL=XNOR(1)*U2(1)+XNOR(2)*U2(2)+XNOR(3)*U2(3)
  372.               XL=0.
  373.               DO i=1,3
  374.                 XNOR(i)=XNOR(i)-YL*U2(i)
  375.                 XL=XL+XNOR(i)*XNOR(i)
  376.               ENDDO
  377.               IF (XL.LT.EPSI) THEN
  378.                 CALL ERREUR(238)
  379.                 GOTO 110
  380.               ENDIF
  381.               XL=1./SQRT(XL)
  382.               XNOR(1)=XNOR(1)*XL
  383.               XNOR(2)=XNOR(2)*XL
  384.               XNOR(3)=XNOR(3)*XL
  385.             ENDIF
  386. C  XNOR contient la direction normee
  387. *            SEGINI,XMATRI
  388. *            IMATTT(IB)=XMATRI
  389.             RE(1,1,ib)=RIG*XNOR(1)*XNOR(1)
  390.             RE(2,1,ib)=RIG*XNOR(1)*XNOR(2)
  391.             RE(1,2,ib)=RE(2,1,ib)
  392.             RE(2,2,ib)=RIG*XNOR(2)*XNOR(2)
  393.             IF (IDIM.EQ.3) THEN
  394.               RE(1,3,ib)=RIG*XNOR(1)*XNOR(3)
  395.               RE(3,1,ib)=RE(1,3,ib)
  396.               RE(2,3,ib)=RIG*XNOR(2)*XNOR(3)
  397.               RE(3,2,ib)=RE(2,3,ib)
  398.               RE(3,3,ib)=RIG*XNOR(3)*XNOR(3)
  399.             ENDIF
  400. *            SEGDES,XMATRI
  401.           ENDDO
  402.           SEGDES,xMATRI
  403. C  Option DIRECTION
  404.         ELSE IF (IDIREC.EQ.1) THEN
  405. *          SEGINI,XMATRI
  406.           RE(1,1,1)=RIG*XNOR(1)*XNOR(1)
  407.           RE(2,1,1)=RIG*XNOR(1)*XNOR(2)
  408.           RE(1,2,1)=RE(2,1,1)
  409.           RE(2,2,1)=RIG*XNOR(2)*XNOR(2)
  410.           IF (IDIM.EQ.3) THEN
  411.             RE(1,3,1)=RIG*XNOR(1)*XNOR(3)
  412.             RE(3,1,1)=RE(1,3,1)
  413.             RE(2,3,1)=RIG*XNOR(2)*XNOR(3)
  414.             RE(3,2,1)=RE(2,3,1)
  415.             RE(3,3,1)=RIG*XNOR(3)*XNOR(3)
  416.           ENDIF
  417.           DO i=2,NBPOIN
  418.              do io=1,re(/2)
  419.                do iu=1,re(/1)
  420.                  re(iu,io,i)=re(iu,io,1)
  421.                enddo
  422.              enddo
  423.           ENDDO
  424.           SEGDES,XMATRI
  425. *          SEGDES,IMATRI
  426. C  Autres options :
  427.         ELSE
  428. *          SEGINI,XMATRI
  429. *          IXMATR=XMATRI
  430. *          RE(1,1)=RIG
  431. *          SEGDES,XMATRI
  432.           DO i=1,NBPOIN
  433.             RE(1,1,i)=RIG
  434. *            IMATTT(i)=IXMATR
  435.           ENDDO
  436.           SEGDES,xMATRI
  437.         ENDIF
  438.       ENDDO
  439. C  Fin de la boucle sur les IAA DDLs a bloquer
  440.  
  441.       SEGDES,MRIGID
  442.       CALL ECROBJ('RIGIDITE',KRIGI)
  443.  
  444.  110  SEGDES,MELEME
  445.  100  SEGSUP,MSWBLO
  446.       SEGDES MCOORD
  447.       RETURN
  448.       END
  449.  
  450.  
  451.  
  452.  
  453.  
  454.  
  455.  
  456.  
  457.  
  458.  
  459.  

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