Télécharger la plaquette Cast3M


fr en

Télécharger supmas.eso

Retour à la liste

Numérotation des lignes : 

supmas

  1. C SUPMAS    SOURCE    CB215821  20/11/25    13:40:27     10792          
  2.       SUBROUTINE SUPMAS
  3. c
  4. c   sous routine pour calculer la masse
  5. c   sur les ddl maitres d'un super element
  6. c   option MASS de SUPE
  7. c
  8. c   Pierre Pegon (CCR d'Ispra), Juin 1997
  9. c
  10. c   l'option LCHP permet d'avoir les vecteurs de MSUPCH dans un LCHPO
  11. c
  12. c
  13.       IMPLICIT INTEGER(I-N)
  14.       IMPLICIT REAL*8(A-H,O-Z)
  15. c
  16.  
  17. -INC PPARAM
  18. -INC CCOPTIO
  19. -INC SMELEME
  20. -INC SMRIGID
  21. -INC SMSUPER
  22. -INC SMMATRI
  23. -INC SMVECTD
  24. -INC SMCHPOI
  25. -INC TMTRAV
  26. c
  27.       CHARACTER*4 INCL
  28. c
  29.       SEGMENT MSUPCH(NBINMA)
  30.       SEGMENT ISECO(LL)
  31.       SEGMENT VSE(LL)*D
  32. c
  33. -INC SMLCHPO
  34.       PARAMETER(NOLIS=1)
  35.       CHARACTER*4 MOLIS(NOLIS)
  36.       DATA MOLIS/'LCHP'/
  37. c
  38. c *** lecture des objets en entre
  39. c
  40.       CALL LIROBJ ('SUPERELE',MSUPER,1,IRETOU)
  41.       IF(IERR.NE.0) RETURN
  42.       CALL LIROBJ ('RIGIDITE',RI2,1,IRETOU)
  43.       IF(IERR.NE.0) RETURN
  44. c
  45. c *** option LCHP
  46. c
  47.       CALL LIRMOT(MOLIS,NOLIS,LCHP,0)
  48. c
  49. c *** mcrout contient la decomposition modifiee de la rigidite
  50. c
  51.       SEGACT MSUPER*MOD
  52.       MMATRI=MCROUT
  53. c
  54. c *** dimension de la matrice condensee
  55. c
  56.       MRIGID=MSURAI
  57.       SEGACT MRIGID
  58.       xMATRI=IRIGEL(4,1)
  59.       MOHAR=IRIGEL(5,1)
  60.       SEGACT xMATRI
  61. *      XMATRI=IMATTT(1)
  62. *      SEGACT XMATRI
  63.       NLIGRA=RE(/1)
  64.       SEGDES XMATRI*NOMOD
  65. *      SEGDES IMATRI*NOMOD
  66.       SEGDES MRIGID*NOMOD
  67. c
  68. c *** autres dimensions
  69. c
  70.       SEGACT MMATRI
  71.       MILIGN=IILIGN
  72.       SEGACT MILIGN
  73.       NBNNMA=IPNO(/1)-NLIGRA
  74.       NNOEU=ILIGN(/1)
  75.       MINCPO=IINCPO
  76.       SEGACT MINCPO
  77.       MDNOR=IDNORM
  78.       SEGACT MDNOR
  79. c
  80. c *** lecture de la geometrie et du descripteur lies a
  81. c     la matrice de rigidite complete
  82. c
  83.       IPT1=IGEOMA
  84.       SEGACT IPT1
  85.       MIDUA=IIDUA
  86.       MIMIK=IIMIK
  87.       SEGACT MIDUA,MIMIK
  88. c
  89. c *** on cherche a partir de ou commence les ligne au dela de NBNNMA
  90. c     et on en profite pour activer TOUTES les lignes
  91. c
  92.       I1=0
  93.       ILA=0
  94.       DO I=1,NNOEU
  95.         LIGN=ILIGN(I)
  96.         SEGACT LIGN
  97.         NA=IMMM(/1)
  98.         ILA=ILA+NA
  99.         IF(ILA.GT.NBNNMA.AND.I1.EQ.0) THEN
  100.           I1=I
  101.           ILA1=ILA-NA
  102.         ENDIF
  103.       ENDDO
  104. c
  105. c *** creation du segment de travail et debut de son remplissage
  106. c
  107.       NNNOE=IPT1.NUM(/2)
  108.       NNIN=IMIK(/2)
  109.       SEGINI MTRAV
  110.       DO I=1,NNNOE
  111.         IGEO (I)=IPT1.NUM(1,I)
  112.       ENDDO
  113.       DO I=1,NNIN
  114.         INCO(I)=IMIK(I)
  115.         NHAR(I)=MOHAR
  116.       ENDDO
  117.       DO I=1,NNNOE
  118.         DO J=1,NNIN
  119.           NUM1=INCPO(J,I)
  120.           IF (NUM1.NE.0) IBIN(J,I)=1
  121.         ENDDO
  122.       ENDDO
  123. c
  124. c *** on initialise le segment des chpo "intermediaires de calcul"
  125. c     que l'on va remplir successivement avec le vecteur formant les
  126. c     ligne de la matrice rectangulaire [ -R*(L**-1) I ]
  127. c
  128.       NBINMA=NLIGRA
  129.       SEGINI MSUPCH
  130. c
  131. c *** on loop sur les lignes qui represente R ...
  132. c
  133.       INC=IPNO(/1)
  134.       SEGINI,MVECTD
  135. c
  136.       DO INOEUD=I1,NNOEU
  137.         LIG1=ILIGN(INOEUD)
  138.         NA1=LIG1.IMMM(/1)
  139.         IDEB1=1
  140.         LPREC1=0
  141.         DO IDDL=1,NA1
  142.           ILA1=ILA1+1
  143.           IF(ILA1.LE.NBNNMA)GOTO 50
  144. c
  145. c *** ... et on remplie VECTBB avec EN CHANGEANT LE SIGNE
  146. c
  147.           CALL ZERO(VECTBB,1,INC)
  148.           IFIN1=LIG1.IPPVV(IDDL+1)-1
  149.           IDEB21=LIG1.IVPO(2*IDEB1)
  150.           LONG1=LIG1.IVPO(2*(IFIN1+1)-1)-LIG1.IVPO(2*IDEB1-1)
  151.           IPRECOL1=ILA1-LONG1
  152.           DO INDIC1=IDEB1,IFIN1
  153.             IFIN21=LIG1.IVPO(2*(INDIC1+1))-1
  154.             ICOL1=LIG1.IVPO(2*INDIC1-1)+IPRECOL1-LPREC1
  155.             IF (ICOL1.GT.NBNNMA) GOTO 1
  156.             DO K1=IDEB21,IFIN21
  157.               VECTBB(ICOL1)=-LIG1.VAL(K1)
  158.               ICOL1=ICOL1+1
  159.               IF(ICOL1.GT.NBNNMA) GOTO 1
  160.             ENDDO
  161.             IDEB21=IFIN21+1
  162.           ENDDO
  163.  1        CONTINUE
  164. c
  165. c *** on de-normalise la ligne
  166. c
  167.           XNORM1=DNOR(ILA1)
  168.           DO I=1,NBNNMA
  169.             VECTBB(I)=VECTBB(I)/XNORM1
  170.           ENDDO
  171. c
  172. c *** on resout avec L transpose sur ce vecteur ("MOND1")
  173. c
  174.           ILA=NBNNMA+NLIGRA+1
  175. c
  176.           DO I=NNOEU,1,-1
  177.             LIGN=ILIGN(I)
  178.             NA=IMMM(/1)
  179.             IFIB=IVPO(/1)
  180.             IF(ILA-NA.GT.NBNNMA)THEN
  181.               ILA=ILA-NA
  182.               GOTO 5
  183.             ENDIF
  184.             IMOI1=IVPO(2*IPPVV(NA+1)-1)
  185.             DO J=NA,1,-1
  186.               ILA=ILA-1
  187.               IDEB2=IPPVV(J)*2
  188.               IMOI2=IVPO(IDEB2-1)
  189.               LLOM=IMOI1-IMOI2-1
  190.               IF (LLOM.LE.0)GOTO 3
  191.               IF (ILA.GT.NBNNMA)GOTO 3
  192.               IPOSM=IMOI2-1
  193.               VKON=VECTBB(ILA)
  194.               IPLAC=IVPO(IDEB2)-1
  195.               IDEBZ=1
  196.               IPLAC2=ILA-LLOM-1
  197.               DO IDEB3=IDEB2,IFIB-1,2
  198.                 IMOI = IVPO ( IDEB3+2 )
  199.                 ILONZ=IMOI -IPLAC-IDEBZ
  200.                 IPLAC=IPLAC-IPLAC2
  201.                 IDEBZC=IDEBZ+IPLAC2
  202.                 DO K=IDEBZC,MIN(IDEBZC+ILONZ,ILA)-1
  203.                   VECTBB(K)=VECTBB(K)-VKON*VAL(IPLAC+K)
  204.                 ENDDO
  205.                 IF (IDEBZ.GE.LLOM) GOTO 3
  206.                 IDEBZ=IVPO(IDEB3+1)-IPOSM
  207.                 IPLAC=IMOI-IDEBZ
  208.               ENDDO
  209.  3            CONTINUE
  210.               IMOI1=IMOI2
  211.             ENDDO
  212.  5          CONTINUE
  213.           ENDDO
  214. c
  215. c *** on normalise la colonne resultat
  216. c
  217.           XNORM1=DNOR(ILA1)
  218.           DO I=1,NBNNMA
  219.             VECTBB(I)=VECTBB(I)*DNOR(I)
  220.           ENDDO
  221. c
  222. c *** on met 1 en position ILA1
  223. c
  224.           VECTBB(ILA1)=1.D0
  225. c
  226. c *** on cree le chpoint resultat
  227. c
  228.           DO I=1,NNNOE
  229.             DO J=1,NNIN
  230.               NUM1=INCPO(J,I)
  231.               IF (NUM1.NE.0) BB(J,I)=VECTBB(NUM1)
  232.             ENDDO
  233.           ENDDO
  234.           CALL CRECHP(MTRAV,ISOLU)
  235.           SEGACT MTRAV*MOD
  236. c
  237. c *** ce champ de nature discrete est stocke dans MSUPCH
  238. c
  239.           MCHPOI = ISOLU
  240.           SEGACT,MCHPOI*MOD
  241.           JATTRI(1)=2
  242.           SEGDES MCHPOI
  243.           MSUPCH(ILA1-NBNNMA)=MCHPOI
  244. c
  245. c *** fin de la boucle sur les lignes representant R
  246. c
  247.  50       CONTINUE
  248.           IDEB1=IFIN1+1
  249.           LPREC1=LPREC1+LONG1
  250.         ENDDO
  251.       ENDDO
  252. c
  253. c *** desactivations diverses et variees
  254. c
  255.       DO I=1,NNOEU
  256.         LIGN=ILIGN(I)
  257.         SEGDES LIGN*NOMOD
  258.       ENDDO
  259.       SEGDES MIDUA*NOMOD,MIMIK*NOMOD
  260.       SEGDES MDNOR*NOMOD
  261.       SEGDES MINCPO*NOMOD
  262.       SEGDES MILIGN*NOMOD
  263.       SEGDES IPT1
  264.       SEGDES MMATRI*NOMOD
  265.       SEGSUP MVECTD,MTRAV
  266. c
  267. c *** on attaque la condensation de la masse que l'on trouve
  268. c     en effectuant les produits scalaires entre V et M*W ou
  269. c     V et W sont des vecteurs de MSUPCH
  270. c
  271.       RI1=MSURAI
  272.       SEGACT RI1
  273.       SEGINI,MRIGID=RI1
  274.       SEGDES RI1
  275.       MTYMAT='MASSE'
  276.       NELRIG=1
  277.       LL=MSUPCH(/1)
  278.       SEGINI ISECO,VSE
  279.       DO IH=1,LL
  280.         ISECO(IH)=MSUPCH(IH)
  281.       ENDDO
  282.       NLIGRP=LL
  283.       NLIGRD=LL
  284.       SEGINI XMATRI
  285. *      SEGINI IMATRI
  286. *      IMATTT(1)=XMATRI
  287.       DO J=1,LL
  288.         SEGACT ISECO
  289.         MCH1= ISECO(J)
  290.         SEGDES ISECO,VSE
  291.         CALL YTMXMU(MCH1,ISECO,J,RI2,VSE)
  292.         SEGACT VSE
  293.         DO  K=1,J
  294.           RE(J,K,1)=VSE(K)
  295.           RE(K,J,1)=VSE(K)
  296.         ENDDO
  297.       ENDDO
  298.       SEGDES XMATRI
  299. *      SEGDES IMATRI
  300.       IRIGEL(4,1)=xMATRI
  301.       ICHOLE=0
  302.       SEGDES MRIGID
  303.       MSUMAS=MRIGID
  304.       CALL ECROBJ('RIGIDITE',MSUMAS)
  305. c
  306. c *** on fait le menage
  307. c
  308.       SEGDES MSUPER
  309.       SEGSUP ISECO,VSE
  310. c
  311. c *** option LCHP ou non
  312. c
  313.       IF(LCHP.EQ.1)THEN
  314.         N1=NBINMA
  315.         SEGINI MLCHPO
  316.         DO I=1,NBINMA
  317.           MCHPOI=MSUPCH(I)
  318.           ICHPOI(I)=MCHPOI
  319.           SEGDES MCHPOI
  320.         ENDDO
  321.         SEGDES MLCHPO
  322.         CALL ECROBJ('LISTCHPO',MLCHPO)
  323.       ELSE
  324.         DO I=1,NBINMA
  325.           MCHPOI=MSUPCH(I)
  326.           CALL DTCHPO(MCHPOI)
  327.         ENDDO
  328.       ENDIF
  329.       SEGSUP MSUPCH
  330. c
  331. c *** au revoir
  332. c
  333.       RETURN
  334.       END
  335.  
  336.  
  337.  
  338.  
  339.  
  340.  
  341.  
  342.  
  343.  

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