Télécharger la plaquette Cast3M


fr en

Télécharger bloque.eso

Retour à la liste

Numérotation des lignes : 

bloque

  1. C BLOQUE    SOURCE    MB234859  26/07/23    21:15:06     12603          
  2. C-----------------------------------------------------------------------
  3. C  Cet operateur impose les BLOCAGES
  4. C
  5. C  Syntaxe 1 :
  6. C
  7. C        ENC1 = BLOQUER ( DEPL ) ( ROTA )  POI1
  8. C
  9. C    ou  ENC1 = BLOQUER  RADIAL  P1  (P2)  MELEME
  10. C                        ORTHOR  P1  (P2)  MELEME
  11. C
  12. C    ou  ENC1 = BLOQUER (DEPL) (ROTA) DIRECTION V1  MELEME
  13. C
  14. C        DIM = 1        ( UX UY UZ ) ou ( UR UZ )  |
  15. C        DIM = 2 OU 3   ( UX UY UZ RX RY RZ )      | MELEME
  16. C        AXISYM         ( RX RZ RT UT )            |
  17. C       
  18. C        POI1   = OBJET DE TYPE POINT
  19. C        MELEME = OBJET DE TYPE MELEME
  20. C        ENC1   = OBJET DE TYPE RIGIDITE
  21. C
  22. C  Remarques :
  23. C  1) On peut imposer des BLOCAGES UNILATERAUX en specifiant les
  24. C     mots-cles MINIMUM ou MAXIMUM.
  25. C  2) La condition peut etre imposee strictement ou en moyenne sur les
  26. C     noeuds du maillage en specifiant le mot-cle FAIB.
  27. C
  28. C  Syntaxe 2 :
  29. C
  30. C        ENC1 = BLOQUER TAB1
  31. C
  32. C        POI1   = OBJET DE TYPE TABLE de sous-type LIAISONS_STATIQUES
  33. C        ENC1   = OBJET DE TYPE RIGIDITE
  34. C-----------------------------------------------------------------------
  35. C  Juillet 2003 : passage a un seul multiplicateur
  36. C-----------------------------------------------------------------------
  37.  
  38.       SUBROUTINE BLOQUE
  39.  
  40.       IMPLICIT INTEGER(I-N)
  41.       IMPLICIT REAL*8 (A-H,O-Z)
  42.  
  43. -INC PPARAM
  44. -INC CCOPTIO
  45. -INC CCGEOME
  46. -INC CCREEL
  47. -INC CCHAMP
  48. -INC SMCHPOI
  49. -INC TMTRAV
  50.       POINTEUR MTRAF.MTRAV
  51. -INC SMCOORD
  52. -INC SMELEME
  53. -INC SMLMOTS
  54. -INC SMMODEL
  55. -INC SMCHAML
  56. -INC SMRIGID
  57. -INC SMTABLE
  58.  
  59.       DIMENSION XNOR(3),U1(3),U2(3)
  60.  
  61.       CHARACTER*(LOCHPO) CHADDL
  62.       CHARACTER*8 MOTRIG
  63.       CHARACTER*4 MOTTCL(1),MOTPV(3) ,MOTBLO(5)
  64.       CHARACTER*4 MODEPL(6),MODEDU(6),MOROTA(5),MORODU(5)
  65.       CHARACTER*4 MODE1D(2),MOFO1D(2)
  66.  
  67.       DATA EPSI   / 1.D-12 /
  68.       DATA MOTRIG / 'RIGIDITE' /
  69.       DATA MOTTCL / 'FAIB' /
  70.       DATA MOTPV  / 'MINI','MAXI','FROT' /
  71.       DATA MOTBLO / 'DEPL','ROTA','RADI','ORTH','DIRE' /
  72.       DATA MODEPL / 'UX  ','UY  ','UZ  ','UR  ','UZ  ','UT  ' /
  73.       DATA MODEDU / 'FX  ','FY  ','FZ  ','FR  ','FZ  ','FT  ' /
  74.       DATA MOROTA / 'RX  ','RY  ','RZ  ','RT  ','RS  ' /
  75.       DATA MORODU / 'MX  ','MY  ','MZ  ','MT  ','MS  ' /
  76. C Tableaux MODE1D et MOFO1D sont utilises pour certains modes 1D
  77.       DATA MODE1D / 'UX  ','UZ  ' /
  78.       DATA MOFO1D / 'FX  ','FZ  ' /
  79.  
  80. C  Pour ne pas avoir de verrouillage sur MCOORD en //
  81.       SEGDES,MCOORD
  82.       SEGACT,MCOORD*MOD
  83. C     ------------------------------------------------------------------
  84. C     Syntaxe 2 : Lecture d'une table LIAISONS STATIQUES
  85. C     ------------------------------------------------------------------
  86.       CALL LIRTAB('LIAISONS_STATIQUES',ipt,0,iretou)
  87.       IF (IRETOU.NE.0) THEN
  88.         CALL BLOQU2(IPT)
  89.         RETURN
  90.       ENDIF
  91. C     ------------------------------------------------------------------
  92. C     Syntaxe 1 : Lecture des arguments
  93. C     ------------------------------------------------------------------
  94. C     0- Initialisations selon le type de probleme
  95.       idimp1=IDIM+1
  96.       ISPE1D=0
  97. C     Deformations planes ou contraintes planes ou defo. plane gene :
  98.       IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-3) THEN
  99.         LDEPL=2
  100.         IADEPL=0
  101.         LROTA=1
  102.         IAROTA=2
  103. C     Axisymetrique :
  104.       ELSE IF (IFOUR.EQ.0) THEN
  105.         LDEPL=2
  106.         IADEPL=3
  107.         LROTA=1
  108.         IAROTA=3
  109. C     Fourier :
  110.       ELSE IF (IFOUR.EQ.1) THEN
  111.         LDEPL=3
  112.         IADEPL=3
  113.         LROTA=1
  114.         IAROTA=3
  115. C     Tridimensionnel :
  116.       ELSE IF (IFOUR.EQ.2) THEN
  117.         LDEPL=3
  118.         IADEPL=0
  119.         LROTA=3
  120.         IAROTA=0
  121. C     Massif 1D (IDIM=1) :
  122.       ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN
  123.         IF (IFOUR.LE.6) THEN
  124.           LDEPL=1
  125.           IADEPL=0
  126.         ELSE IF (IFOUR.GE.7.AND.IFOUR.LE.10) THEN
  127.           LDEPL=2
  128.           IADEPL=0
  129.           IF (IFOUR.EQ.9.OR.IFOUR.EQ.10) ISPE1D=1
  130.         ELSE IF (IFOUR.EQ.11) THEN
  131.           LDEPL=3
  132.           IADEPL=0
  133.         ELSE IF (IFOUR.EQ.15) THEN
  134.           LDEPL=2
  135.           IADEPL=3
  136.         ELSE
  137.           LDEPL=1
  138.           IADEPL=3
  139.         ENDIF
  140.         LROTA=0
  141.         IAROTA=0
  142. C     Autres cas :
  143.       ELSE
  144.         LDEPL=0
  145.         IADEPL=0
  146.         LROTA=0
  147.         IAROTA=0
  148.       ENDIF
  149. C
  150.       KPOINT=0
  151.       ILUMO1=0
  152.       ILUMO2=0
  153.       MLMOT1=0
  154.       MLMOT2=0
  155.       MTRAV=0
  156.       MTRAF=0
  157. C
  158. C     1- Type de la condition (unilaterale ou non)
  159. C     Lecture eventuelle de 'MAXI','MINI'
  160. C     -----------------------------------------------------------------
  161.       NILATE=0
  162.       CALL LIRMOT(MOTPV,3,IPO,0)
  163.       IF (IPO.EQ.1) NILATE=-1
  164.       IF (IPO.EQ.2) NILATE=1
  165.       IF (IPO.EQ.3) NILATE=2
  166. C     Pas de frottement en 1D
  167.       IF (IPO.EQ.3.AND.IDIM.EQ.1) THEN
  168.         INTERR(1)=IDIM
  169.         MOTERR(1:4)=MOTPV(3)
  170.         CALL ERREUR(971)
  171.         GOTO 1000
  172.       ENDIF
  173. C
  174. C     2- Lecture eventuelle des MOTS autres que des DDLS
  175. C     ------------------------------------------------------------------
  176.       IRADIA=0
  177.       IDIREC=0
  178.       IDEPL=0
  179.       IROTA=0
  180. C
  181. C     Lecture eventuelle de 'FAIB'
  182. C     -----------------------------------------------------------------     
  183.       CALL LIRMOT(MOTTCL,1,IFAIBL,0)
  184. C
  185. C     Lecture eventuelle de 'RADI','ORTH'
  186. C     -----------------------------------------------------------------     
  187.       CALL LIRMOT(MOTBLO(3),2,IMOT,0)
  188.       IF (IMOT.NE.0) THEN
  189. C       En DIMENSION 1, les mots-cles 'RADI,'ORTH' sont interdits
  190.         IF (IDIM.EQ.1) THEN
  191.           INTERR(1)=IDIM
  192.           MOTERR(1:4)=MOTBLO(2+IMOT)
  193.           CALL ERREUR(971)
  194.           GOTO 1000
  195.         ENDIF
  196.         IRADIA=IMOT
  197. C
  198.         CALL LIROBJ('POINT',IPOIN1,1,IRETOU)
  199.         IF (IRETOU.EQ.0) GOTO 1000
  200.         j=(IPOIN1-1)*idimp1
  201.         DO i=1,IDIM
  202.           U1(i)=XCOOR(j+i)
  203.         ENDDO
  204.         IF (IDIM.EQ.3) THEN
  205.           CALL LIROBJ('POINT',IPOIN2,1,IRETOU)
  206.           IF (IRETOU.EQ.0) GOTO 1000
  207.           j=(IPOIN2-1)*idimp1
  208.           YL=0.D0
  209.           DO i=1,IDIM
  210.             U2(i)=XCOOR(j+i)-U1(i)
  211.             YL=YL+U2(i)*U2(i)
  212.           ENDDO
  213. C         Calcul du vecteur directeur unitaire de l'axe (U2)
  214.           IF (YL.LT.EPSI) THEN
  215.             CALL ERREUR(237)
  216.             GOTO 1000
  217.           ENDIF
  218.           YL=1.D0/SQRT(YL)
  219.           DO i=1,IDIM
  220.             U2(i)=U2(i)*YL
  221.           ENDDO
  222.         ENDIF
  223. C
  224.         IBDDL=LDEPL
  225.         GOTO 4481
  226.       ENDIF
  227. C
  228. C     Lecture eventuelle de 'DEPL' et/ou 'ROTA'
  229. C     -----------------------------------------------------------------     
  230.       IBDDL=0
  231.  4480 CONTINUE
  232.       CALL LIRMOT(MOTBLO,2,IMOT,0)
  233.       IF (IMOT.EQ.1) THEN
  234.         IDEPL=1
  235.         IBDDL=IBDDL+LDEPL
  236.         GOTO 4480
  237.       ELSEIF (IMOT.EQ.2) THEN
  238.         IROTA=1
  239.         IBDDL=IBDDL+LROTA
  240.         GOTO 4480
  241.       ENDIF
  242. C
  243.  4481 CONTINUE
  244.       IF (IRADIA.NE.0 .OR. IDEPL.NE.0 .OR. IROTA.NE.0) THEN
  245.         JGN=LOCHPO
  246.         JGM=IBDDL
  247.         SEGINI,MLMOT1,MLMOT2
  248. C
  249.         IDEB=0
  250.         IF (IRADIA.NE.0 .OR. IDEPL.EQ.1) THEN
  251. C         Cas particulier pour certains modes de IDIM=1
  252.           IF (ISPE1D.EQ.1) THEN
  253.             DO i=1,LDEPL
  254.               MLMOT1.MOTS(i)=MODE1D(IADEPL+i)
  255.               MLMOT2.MOTS(i)=MOFO1D(IADEPL+i)
  256.             ENDDO
  257. C         Cas general
  258.           ELSE
  259.             DO i=1,LDEPL
  260.               MLMOT1.MOTS(i)=MODEPL(IADEPL+i)
  261.               MLMOT2.MOTS(i)=MODEDU(IADEPL+i)
  262.             ENDDO
  263.           ENDIF
  264.           IDEB=LDEPL
  265.         ENDIF
  266.         IF (IROTA.EQ.1) THEN
  267.           DO i=1,LROTA
  268.             MLMOT1.MOTS(IDEB+i)=MOROTA(IAROTA+i)
  269.             MLMOT2.MOTS(IDEB+i)=MORODU(IAROTA+i)
  270.           ENDDO
  271.         ENDIF
  272.       ENDIF
  273.       IF (IRADIA.NE.0) GOTO 449
  274. C
  275. C     Lecture eventuelle de 'DIRE'
  276. C     -----------------------------------------------------------------     
  277.       CALL LIRMOT(MOTBLO(5),1,IMOT,0)
  278.       IF (IMOT.EQ.0) THEN
  279.         IF (IBDDL.NE.0) GOTO 449
  280.         IF (IBDDL.EQ.0) GOTO 445
  281.       ENDIF
  282.       IDIREC=1
  283. C
  284.       IF (IDEPL.NE.0.AND.IROTA.NE.0) THEN
  285.         MOTERR(1:128)='DEPL ROTA'
  286.         CALL ERREUR(-385)
  287.         MOTERR(1:8)='DIRE'
  288.         CALL ERREUR(803)
  289.         GOTO 1000
  290.       ENDIF
  291. C
  292.       CALL LIROBJ('POINT',IPOINT,0,IRETOU)
  293.       IF (IRETOU.EQ.0) THEN
  294.         CALL LIROBJ('CHPOINT ',MCHPOI,1,IRETOU)
  295.         CALL ACTOBJ('CHPOINT ',MCHPOI,1)
  296.         IF (IERR.NE.0) GOTO 1000
  297.         IDIREC=2
  298.         IF (IDEPL.EQ.0.AND.IROTA.EQ.0) THEN
  299. C         Les composantes seront donnees par le champ
  300.           IDIREC=3
  301.           CALL EXTR11(MCHPOI,MLMOT3)
  302.           SEGACT,MLMOT3
  303.           IBDDL=MLMOT3.MOTS(/2)
  304.           IF (IBDDL.LE.0) THEN
  305.             MOTERR(1:8)='CHPOINT'
  306.             CALL ERREUR(1027)
  307.             GOTO 1000
  308.           ENDIF
  309. C
  310.           JGN=LOCHPO
  311.           JGM=IBDDL
  312.           SEGINI,MLMOT1,MLMOT2
  313. C
  314.           DO IC=1,IBDDL
  315.             CALL PLACE(NOMDU,LNOMDU,IDUA,MLMOT3.MOTS(IC))
  316.             IF (IDUA.NE.0) THEN
  317.               MLMOT1.MOTS(IC)=NOMDD(IDUA)
  318.               MLMOT2.MOTS(IC)=NOMDU(IDUA)
  319.             ELSE
  320.               CALL PLACE(NOMDD,LNOMDD,IPRI,MLMOT3.MOTS(IC))
  321.               IF (IPRI.EQ.0) THEN
  322.                 MOTERR(1:4)=MLMOT3.MOTS(IC)
  323.                 CALL ERREUR(108)
  324.                 GOTO 1000
  325.               ENDIF
  326.               MLMOT1.MOTS(IC)=NOMDD(IPRI)
  327.               MLMOT2.MOTS(IC)=NOMDU(IPRI)
  328.             ENDIF
  329.           ENDDO
  330.           SEGSUP,MLMOT3
  331.         ENDIF
  332.         MCHPO1=0
  333.         CALL NOMC2(MCHPOI,MLMOT2,MLMOT1,MCHPO1)
  334.         IF (IERR.NE.0) GOTO 1000
  335.       ELSE
  336.         j=(IPOINT-1)*idimp1
  337.         YL=0.D0
  338.         DO i=1,IDIM
  339.           XNOR(i)=XCOOR(j+i)
  340.           YL=YL+XNOR(i)*XNOR(i)
  341.         ENDDO
  342.         IF (YL.LT.EPSI) THEN
  343.           CALL ERREUR(239)
  344.           GOTO 1000
  345.         ENDIF
  346.         YL=1.D0/SQRT(YL)
  347.         DO i=1,IDIM
  348.           XNOR(i)=XNOR(i)*YL
  349.         ENDDO
  350.       ENDIF
  351.       GOTO 449
  352. C
  353. C     3- Lecture eventuelle de DDLs
  354. C     -----------------------------------------------------------------
  355.  445  CONTINUE
  356. C     Sous la forme de LISTMOTS
  357.       CALL LIROBJ('LISTMOTS',MLMOT1,0,IRETOU)
  358.       IF (IERR.NE.0) GOTO 1000
  359.       IF (IRETOU.EQ.0) GOTO 444
  360.       ILUMO1=MLMOT1
  361. C
  362.       CALL LIROBJ('LISTMOTS',MLMOT2,0,IRETO2)
  363.       IF (IERR.NE.0) GOTO 1000
  364. C
  365.       SEGACT,MLMOT1
  366.       IBDDL=MLMOT1.MOTS(/2)
  367.       IF (IBDDL.LE.0) THEN
  368.         CALL ERREUR(643)
  369.         GOTO 1000
  370.       ENDIF
  371. C
  372.       IF (IRETO2.EQ.0) THEN
  373. C       Les composantes DUALES ne sont pas fournies : piocher dans NOMDU
  374.         SEGINI,MLMOT2=MLMOT1
  375.         DO IMOT=1,IBDDL
  376.           CALL PLACE(NOMDD,LNOMDD,idd,MLMOT1.MOTS(IMOT))
  377.           IF (IERR.NE.0) GOTO 1000
  378.           IF (IDD.LE.0) THEN
  379.             MOTERR(1:4)=MLMOT1.MOTS(IMOT)
  380.             CALL ERREUR(108)
  381.             GOTO 1000
  382.           ELSE
  383.             MLMOT2.MOTS(IMOT)=NOMDU(IDD)
  384.           ENDIF
  385.         ENDDO
  386.       ELSE
  387.         ILUMO2=MLMOT2
  388.         SEGACT,MLMOT2
  389.         IF (IBDDL.NE.MLMOT2.MOTS(/2)) THEN
  390.           CALL ERREUR(854)
  391.           SEGDES,MLMOT1,MLMOT2
  392.           GOTO 1000
  393.         ENDIF
  394.       ENDIF
  395.       GOTO 449
  396. C
  397.  444  CONTINUE
  398. C
  399.       JGN=LOCHPO
  400.       JGM=6
  401.       SEGINI,MLMOT1,MLMOT2
  402.       IBDDL=0
  403. C
  404.  446  CONTINUE
  405. C     Sous forme de MOTs
  406.       CALL LIRCHA(CHADDL,0,IMOT)
  407.       IF (IMOT.EQ.0) THEN
  408.         JGN=LOCHPO
  409.         JGM=IBDDL
  410.         SEGADJ,MLMOT1,MLMOT2
  411.         GOTO 447
  412.       ENDIF
  413.       CALL PLACE(NOMDD,LNOMDD,IMOT,CHADDL)
  414.       IF (IERR.NE.0) GOTO 1000
  415.       IF (IMOT.NE.0) THEN
  416.         IBDDL=IBDDL+1
  417.         IF (IBDDL.GT.MLMOT1.MOTS(/2)) THEN
  418.           JGN=LOCHPO
  419.           JGM=JGM+6
  420.           SEGADJ,MLMOT1,MLMOT2
  421.         ENDIF
  422.         MLMOT1.MOTS(IBDDL)=NOMDD(IMOT)
  423.         MLMOT2.MOTS(IBDDL)=NOMDU(IMOT)
  424.       ELSE
  425.         MOTERR(1:4)=CHADDL
  426.         CALL ERREUR(108)
  427.         GOTO 1000
  428.       ENDIF
  429.       GOTO 446
  430. C
  431. C     Conditions aux limites via un MODELE --> non documente
  432.  447  CONTINUE
  433.       IPMODL=0
  434.       CALL LIROBJ('MMODEL  ',IPMODL,0,IRETOU)
  435.       IF (IRETOU.EQ.0) GOTO 449
  436.       CALL ACTOBJ('MMODEL  ',IPMODL,1)
  437.       CALL NOVARD(IPMODL,'DEPL')
  438.       CALL LIROBJ('LISTMOTS',MLMOT1,1,IRETOU)
  439.       IF (IERR.NE.0) GOTO 1000
  440.       CALL NOVARD(IPMODL,'FORC')
  441.       CALL LIROBJ('LISTMOTS',MLMOT2,1,IRETOU)
  442.       IF (IERR.NE.0) GOTO 1000
  443.       SEGACT,MLMOT1,MLMOT2
  444.       IBDDL=MLMOT1.MOTS(/2)
  445. C
  446.  449  CONTINUE
  447. C
  448. C     Verifier que le nombre de DDLs a bloquer n'est pas nul
  449.       IF (IBDDL.EQ.0) THEN
  450.         CALL ERREUR(107)
  451.         GOTO 1000
  452.       ENDIF
  453. C
  454. C     4- Lecture d'un POINT ou d'un MAILLAGE
  455. C     -----------------------------------------------------------------
  456.       CALL LIROBJ('POINT',KPOINT,0,IRETOU)
  457.       IF (IRETOU.EQ.0) THEN
  458.         CALL LIROBJ('MAILLAGE',KOBJET,1,IRETOU)
  459.         IF (IERR.NE.0) GOTO 1000
  460.         IPMAIL=KOBJET
  461.         MELEME=KOBJET
  462.         SEGACT,MELEME
  463.         IF (ITYPEL.NE.1) CALL CHANGE(MELEME,1)
  464.         NBPOIN=NUM(/2)
  465.       ELSE
  466.         MELEME=KPOINT
  467. C       Transforme le POINT en POI1
  468.         CALL CRELEM(MELEME)
  469.         IPMAIL=MELEME
  470.         NBPOIN=1
  471.       ENDIF
  472.       IF (IERR.NE.0) GOTO 1000
  473. C
  474. C     5- Coefficients de la matrice de blocage
  475. C     -----------------------------------------------------------------
  476.       IF (IDIREC.GE.2) THEN
  477. C       MTRAV contient les directions normees (DEPL ou ROTA) ou non
  478. C       1) Recopie des composantes et valeurs pertinentes du chpoint
  479. C          dans le TMTRAV
  480.         CALL CP2TR2(MLMOT1,MELEME,MCHPO1,MTRAV)
  481.         SEGSUP,MCHPO1
  482.         IF (IERR.NE.0) GOTO 1000
  483. C       SEGPRT,MTRAV
  484. C       2) On norme la direction dans le cas DEPL ou ROTA
  485.         IF (IDIREC.EQ.2) THEN
  486.           SEGACT MTRAV*MOD
  487.           DO IBPOIN=1,NBPOIN
  488.             YL=0.D0
  489.             DO I=1,IDIM
  490.               XNOR(I)=BB(I,IBPOIN)
  491.               YL=YL+XNOR(I)*XNOR(I)
  492.             ENDDO
  493.             IF (YL.LT.XPETIT) THEN
  494.               CALL ERREUR(239)
  495.               GOTO 1000
  496.             ENDIF
  497.             YL=1.D0/SQRT(YL)
  498.             DO I=1,IBDDL
  499.               BB(I,IBPOIN)=XNOR(I)*YL
  500.             ENDDO
  501.           ENDDO
  502. C         SEGPRT,MTRAV
  503.         ENDIF
  504.       ENDIF
  505. C
  506.       IF (IRADIA.NE.0) THEN
  507. C       CHPOINT de travail
  508.         NC=IBDDL
  509.         N=NBPOIN
  510.         NAT=1
  511.         NSOUPO=1
  512.         SEGINI,MPOVA2,MSOUP2,MCHPO2
  513.         MCHPO2.IPCHP(1)=MSOUP2
  514.         MSOUP2.IGEOC=MELEME
  515.         MSOUP2.IPOVAL=MPOVA2
  516.         DO IC=1,IBDDL
  517.           MSOUP2.NOCOMP(IC)=MLMOT1.MOTS(IC)
  518.         ENDDO
  519. C
  520.         DO IB=1,NBPOIN
  521.           j=(NUM(1,IB)-1)*idimp1
  522.           DO i=1,IDIM
  523.             XNOR(i)=XCOOR(j+i)-U1(i)
  524.           ENDDO
  525.           IF (IDIM.EQ.2) THEN
  526.             YL=XNOR(1)*XNOR(1)+XNOR(2)*XNOR(2)
  527.             IF (YL.LT.EPSI) THEN
  528.               CALL ERREUR(238)
  529.               GOTO 1000
  530.             ENDIF
  531.             YL=1.D0/SQRT(YL)
  532.             IF (IRADIA.EQ.1) THEN
  533.               XNOR(1)=XNOR(1)*YL
  534.               XNOR(2)=XNOR(2)*YL
  535.             ELSE IF (IRADIA.EQ.2) THEN
  536.               XX=XNOR(1)
  537.               XNOR(1)=-XNOR(2)*YL
  538.               XNOR(2)=XX*YL
  539.             ENDIF
  540.             MPOVA2.VPOCHA(IB,1)=XNOR(1)
  541.             MPOVA2.VPOCHA(IB,2)=XNOR(2)
  542.           ELSE
  543.             YL=XNOR(1)*U2(1)+XNOR(2)*U2(2)+XNOR(3)*U2(3)
  544.             XL=0.D0
  545.             DO i=1,3
  546.               XNOR(i)=XNOR(i)-YL*U2(i)
  547.               XL=XL+XNOR(i)*XNOR(i)
  548.             ENDDO
  549.             IF (XL.LT.EPSI) THEN
  550.               CALL ERREUR(238)
  551.               GOTO 1000
  552.             ENDIF
  553.             IF (IRADIA.EQ.1) THEN
  554.               XL=1.D0/SQRT(XL)
  555.               XNOR(1)=XNOR(1)*XL
  556.               XNOR(2)=XNOR(2)*XL
  557.               XNOR(3)=XNOR(3)*XL
  558.             ELSE IF (IRADIA.EQ.2) THEN
  559.               XX=XNOR(1)
  560.               YY=XNOR(2)
  561.               ZZ=XNOR(3)
  562.               XNOR(1)=YY*U2(3)-ZZ*U2(2)
  563.               XNOR(2)=ZZ*U2(1)-XX*U2(3)
  564.               XNOR(3)=XX*U2(2)-YY*U2(1)
  565.             ENDIF
  566.             MPOVA2.VPOCHA(IB,1)=XNOR(1)
  567.             MPOVA2.VPOCHA(IB,2)=XNOR(2)
  568.             MPOVA2.VPOCHA(IB,3)=XNOR(3)
  569.           ENDIF
  570.         ENDDO
  571.         CALL CP2TR2(MLMOT1,MELEME,MCHPO2,MTRAV)
  572.         SEGSUP,MPOVA2,MSOUP2,MCHPO2
  573.       ENDIF
  574. C
  575.       IF (IFAIBL.EQ.1) THEN
  576.         CALL BLOFAI(IPMAIL,MLMOT1,MCHPO1)
  577.         IF (IERR.NE.0) GOTO 1000
  578.         CALL CP2TR2(MLMOT1,MELEME,MCHPO1,MTRAF)
  579.         SEGSUP,MCHPO1
  580.         YL=0.D0
  581.         DO IC=1,IBDDL
  582.           DO IB=1,NBPOIN
  583.            YL=YL+MTRAF.BB(IC,IB)
  584.           ENDDO
  585.         ENDDO
  586.         IF (YL.LT.XPETIT) THEN
  587.           CALL ERREUR(239)
  588.           GOTO 1000
  589.         ENDIF
  590.         YL=1.D0/YL
  591.         DO IC=1,IBDDL
  592.           ZL=YL
  593.           IF (IDIREC.EQ.1) ZL=YL*XNOR(IC)
  594.           DO IB=1,NBPOIN
  595.             IF ((IDIREC.GE.2).OR.(IRADIA.NE.0)) ZL=YL*BB(IC,IB)
  596.             MTRAF.BB(IC,IB)=MTRAF.BB(IC,IB)*ZL
  597.           ENDDO
  598.         ENDDO
  599.       ENDIF
  600. C
  601. C     6- Creation et remplissage de la rigidite
  602. C     -----------------------------------------------------------------
  603. C     NNMAT : nombre de DDLs a bloquer par noeud et donc nombre de 
  604. C             multiplicateurs a creer par noeud
  605. C     Les cas RADIal et DIREction n'ecrivent qu'une condition par noeud
  606.       NNMAT=IBDDL
  607.       NINCO=1
  608.       NNOEU=1
  609.       IF (IDIREC.NE.0 .OR. IRADIA.NE.0 .OR. IFAIBL.EQ.1) THEN
  610.         NNMAT=1
  611.         NINCO=IBDDL
  612.         IF (IFAIBL.EQ.1) THEN
  613.           NNOEU=NBPOIN
  614.           NBPOIN=1
  615.         ENDIF
  616.       ENDIF
  617. C
  618. C     Initialisation de l'objet RIGIDITE associe aux BLOCAGES
  619.       NRIGEL=NNMAT
  620.       SEGINI,MRIGID
  621.       MTYMAT=MOTRIG
  622.       IFORIG=IFOUR
  623.       ICHOLE=0
  624.       IMGEO1=0
  625.       IMGEO2=0
  626. C
  627. C     Noeud support de chaque multiplicateur de Lagrange
  628. C     NBPOIN : nombre de points du maillage MELEME a bloquer
  629.       NBNO=nbpts
  630.       NBPTS=NBNO+NNMAT*NBPOIN
  631.       SEGADJ,MCOORD
  632. C
  633. C     Boucle sur le nombre de DDLs a bloquer
  634.       DO IAA=1,NNMAT
  635. C
  636. C       Creation du maillage MELEME de MULTiplicateurs associe aux BLOCAGES
  637.         NBSOUS=0
  638.         NBREF=0
  639.         NBNN=1+NNOEU
  640.         NBELEM=NBPOIN
  641.         SEGINI,IPT1
  642.         IPT1.ITYPEL=22
  643.         DO i=1,NBPOIN
  644.           j=(IAA-1)*NBPOIN+i
  645.           IPT1.NUM(1,i)=NBNO+j
  646.           DO k=1,NNOEU
  647.             IPT1.NUM(1+k,i)=NUM(k,i)
  648.             IPT1.ICOLOR(i)=IDCOUL
  649.           ENDDO
  650. C
  651. C         Coordonnees du noeuds support du LX (meme position que les noeuds)
  652.           IREF1=(NBNO+j  -1)*idimp1
  653.           IREF3=(NUM(1,i)-1)*idimp1
  654.           DO j=1,IDIM
  655.             XCOOR(IREF1+j)=XCOOR(IREF3+j)
  656.           ENDDO
  657.         ENDDO
  658. C
  659. C       Creation du descripteur associe au IAA-eme multplicateur
  660.         NLIGRP=1+(NINCO*NNOEU)
  661.         NLIGRD=NLIGRP
  662.         SEGINI,DESCR
  663.         NOELEP(1)=1
  664.         NOELED(1)=1
  665.         LISINC(1)='LX  '
  666.         LISDUA(1)='FLX '
  667.         IF (IDIREC.NE.0 .OR. IRADIA.NE.0 .OR. IFAIBL.EQ.1) THEN
  668.           DO i=1,NINCO
  669.             DO k=1,NNOEU
  670.               l=1+k+(i-1)*NNOEU
  671.               NOELEP(l)=1+k
  672.               NOELED(l)=1+k
  673.               LISINC(l)=MLMOT1.MOTS(i)
  674.               LISDUA(l)=MLMOT2.MOTS(i)
  675.             ENDDO
  676.           ENDDO
  677.         ELSE
  678.           NOELEP(2)=2
  679.           NOELED(2)=2
  680.           LISINC(2)=MLMOT1.MOTS(IAA)
  681.           LISDUA(2)=MLMOT2.MOTS(IAA)
  682.         ENDIF
  683. C
  684. C       Creation de la matrice de rigidite elementaire
  685.         NELRIG=NBPOIN
  686.         RIGREL=0
  687.         SEGINI,XMATRI
  688. C
  689.         IF (IFAIBL.EQ.1) THEN
  690.           DO IB=1,NBPOIN
  691.             RE(1,1,IB)=0.D0
  692.             DO IC=1,NINCO
  693.               DO IK=1,NNOEU
  694.                 l=1+ik+(ic-1)*NNOEU
  695.                 RE(l,1,IB)=MTRAF.BB(IC,IK)
  696.                 RE(1,l,IB)=MTRAF.BB(IC,IK)
  697.               ENDDO
  698.             ENDDO
  699.           ENDDO
  700.         ELSEIF ((IRADIA.NE.0).OR.(IDIREC.GE.2))THEN
  701.           DO IB=1,NBPOIN
  702.             RE(1,1,IB)=0.D0
  703.             DO IC=1,NINCO
  704.               RE(IC+1,1,IB)=BB(IC,IB)
  705.               RE(1,IC+1,IB)=BB(IC,IB)
  706.             ENDDO
  707.           ENDDO
  708.         ELSE IF (IDIREC.EQ.1) THEN
  709.           DO IB=1,NBPOIN
  710.             RE(1,1,IB)=0.D0
  711.             DO IC=1,IDIM
  712.               RE(IC+1,1,IB)=XNOR(IC)
  713.               RE(1,IC+1,IB)=XNOR(IC)
  714.             ENDDO
  715.           ENDDO
  716.         ELSE
  717.           DO IB=1,NBPOIN
  718.             RE(1,1,IB)=0.D0
  719.             RE(2,1,IB)=1.D0
  720.             RE(2,2,IB)=0.D0
  721.             RE(1,2,IB)=RE(2,1,IB)
  722.           ENDDO
  723.         ENDIF
  724. C
  725. C       IAA-eme rigidite elementaire
  726.         COERIG(IAA)=1.D0
  727.         IRIGEL(1,IAA)=IPT1
  728.         IRIGEL(2,IAA)=0
  729.         IRIGEL(3,IAA)=DESCR
  730.         IRIGEL(4,IAA)=XMATRI
  731.         IRIGEL(5,IAA)=NIFOUR
  732.         IRIGEL(6,IAA)=NILATE
  733.       ENDDO
  734. C     Fin de la boucle sur les IAA DDLs a bloquer
  735. C
  736.       CALL RELASI(MRIGID)
  737.       CALL ACTOBJ('RIGIDITE',MRIGID,1)
  738.       CALL ECROBJ('RIGIDITE',MRIGID)
  739. C     ------------------------------------------------------------------
  740. C     Menage avant de quitter
  741. C     ------------------------------------------------------------------
  742.  1000 CONTINUE
  743.       IF (KPOINT.NE.0) SEGSUP,MELEME
  744.       IF (MLMOT1.NE.0 .AND. ILUMO1.EQ.0) SEGSUP,MLMOT1
  745.       IF (MLMOT2.NE.0 .AND. ILUMO2.EQ.0) SEGSUP,MLMOT2
  746.       IF (MTRAV .NE.0) SEGSUP,MTRAV
  747.       IF (MTRAF .NE.0) SEGSUP,MTRAF
  748. C
  749.       END
  750.  
  751.  

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