Télécharger la plaquette Cast3M


fr en

Télécharger masse2.eso

Retour à la liste

Numérotation des lignes : 

masse2

  1. C MASSE2    SOURCE    CB215821  24/04/12    21:16:38     11897          
  2.       SUBROUTINE MASSE2(IPMAIL,NDDL,LRE,NBPGAU,IPMINT,
  3.      &MELE,MFR,IVAMAT,IVACAR,NMATT,IPMATR,ILUMP,IIPDPG)
  4. *---------------------------------------------------------------------*
  5. *        _________________________________                            *
  6. *        |                                |                           *
  7. *        |  calcul de la matrice de masse |                           *
  8. *        |________________________________|                           *
  9. *                                                                     *
  10. *        massif, liquide, 'surface libre ,incompressible              *
  11. *                                                                     *
  12. *---------------------------------------------------------------------*
  13. *                                                                     *
  14. *   entrees :                                                         *
  15. *   ________                                                          *
  16. *                                                                     *
  17. *        ipmail   pointeur sur un segment  meleme                     *
  18. *        nddl     nombre de degre de liberte /noeud                   *
  19. *        lre      nombre de ddl dans la matrice de masse              *
  20. *        nbpgau   nombre de point d'integration pour la masse         *
  21. *        ipmint   pointeur sur un segment minte                       *
  22. *        ipmin1   pointeur sur un segment minte (aux noeuds)          *
  23. *        mele     numero de l'element fini                            *
  24. *        mfr      numero de la formulation                            *                                    *
  25. *        ivamat   pointeur sur un segment mptval pour le materiau ou  *
  26. *                 pour une matrice de hooke                           *
  27. *        ivacar   pointeur sur un segment mptval pour les             *
  28. *                 caracteristiques                                    *
  29. *        nmatt    nombre de composante de materiau (imat=1)           *                       *
  30. *        ilump    =1 si l'opérateur LUMP est appelé
  31. *                                                                     *
  32. *   sorties :                                                         *
  33. *   ________                                                          *
  34. *                                                                     *
  35. *        ipmatr   pointeur sur la matrice de masse de la sous-zone    *
  36. *                                                                     *
  37. *---------------------------------------------------------------------*
  38.       IMPLICIT INTEGER(I-N)
  39.       IMPLICIT REAL*8(A-H,O-Z)
  40. -INC PPARAM
  41. -INC CCOPTIO
  42. -INC CCHAMP
  43. -INC CCREEL
  44. -INC SMRIGID
  45. -INC SMCHAML
  46. -INC SMELEME
  47. -INC SMCOORD
  48. -INC SMINTE
  49. -INC SMMODEL
  50. c
  51.       SEGMENT WRK1
  52.       REAL*8 REL(LRE,LRE),XE(3,NBBB)
  53.       ENDSEGMENT
  54. c
  55.       SEGMENT WRK2
  56.       REAL*8 SHPWRK(6,NBNO),BGENE(NDDL,LRE)
  57.       ENDSEGMENT
  58. c
  59.       SEGMENT WRK5
  60.       REAL*8 BLX(NDDL,LRE),BLY(NDDL,LRE),BLZ(NDDL,LRE)
  61.       REAL*8 BLT(NDDL,LRE)
  62.       ENDSEGMENT
  63. c
  64. c
  65.       SEGMENT WRK6
  66.        REAL*8 PROPEL(1)
  67.        REAL*8 OUT(5)
  68.        REAL*8 WORK1(24*24)
  69.       ENDSEGMENT
  70. c
  71.       SEGMENT MVELCH
  72.       REAL*8 VALMAT(NV1)
  73.       ENDSEGMENT
  74. c
  75. c
  76.       SEGMENT MPTVAL
  77.       INTEGER IPOS(NS),NSOF(NS)
  78.       INTEGER IVAL(NCOSOU)
  79.       CHARACTER*16 TYVAL(NCOSOU)
  80.       ENDSEGMENT
  81. c
  82.       dimension ddhook(3)
  83. *
  84.       MELEME=IPMAIL
  85.       NBNN=NUM(/1)
  86.       NBELEM=NUM(/2)
  87. *
  88.       NV1=NMATT
  89.       SEGINI,MVELCH
  90. *
  91.       xMATRI=IPMATR
  92.       LVAL  = (LRE*(LRE+1))/2
  93.       NLIGRP=LRE
  94.       NLIGRD=LRE
  95. *
  96. *     introduction du point autour duquel se fait le mouvement
  97. *     de la section en defo plane generalisee
  98. *     En 1D : pas de rotation
  99.       IF (IFOUR.EQ.-3) THEN
  100.         IREF=(IIPDPG-1)*(IDIM+1)
  101.         XDPGE=XCOOR(IREF+1)
  102.         YDPGE=XCOOR(IREF+2)
  103.       ELSE
  104.         XDPGE=0.D0
  105.         YDPGE=0.D0
  106.       ENDIF
  107. *
  108.       NHRM=NIFOUR
  109. *
  110.       MINTE=IPMINT
  111.  
  112. c_______________________________________________________________________
  113. c
  114. c     numero des etiquettes      :
  115. c     etiquettes de 1 a 98 pour traitement specifique a l element
  116. c     dans la zone specifique a chaque element commencant par :
  117. c     5  continue
  118. c     element 5   etiquettes 1005 2005 3005 4005   ...
  119. c     44 continue
  120. c     element 44  etiquettes 1044 2044 3044 4044   ...
  121. c_______________________________________________________________________
  122. c
  123.       GOTO (99,99,99,4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99,
  124.      199,99, 4, 4, 4, 4,99,99,99,99,99,99,99,99,35,35,35,35,35,35,
  125.      299,99,99,99,99,99,99,48,99,99,99,99,48,48,99,99,99,99,99,99,
  126.      399,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,99,99,
  127.      499,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  128.      599,99,99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
  129.      64, 4),MELE
  130. * BCN
  131.       IF ((MELE.eq.183).or.(MELE.eq.184)) GOTO 4
  132. * BCN
  133. C= Elements MECANIQUE 1D : M1Dx
  134.       IF (MELE.EQ.193.OR.MELE.EQ.194) GOTO 4
  135.       IF (MELE.EQ.260) GOTO 5
  136.  
  137. * Elements pyramides incompressibles BBAR :
  138.       IF (MELE.EQ.273.OR.MELE.EQ.274) GOTO 4
  139.  
  140.       GOTO 99
  141. c_______________________________________________________________________
  142. c_______________________________________________________________________
  143. c
  144. c     secteur de calcul pour les elements massifs et elements incompressibles
  145. c_______________________________________________________________________
  146. c
  147.    4  CONTINUE
  148.       DIM3=1.D0
  149.       NBNO=NBNN
  150.       NBBB=NBNN
  151.       SEGINI WRK1,WRK2
  152.       I195=0
  153.       I259=0
  154.       DO 3004  IB=1,NBELEM
  155. c
  156. c        on cherche  les coordonnees des noeuds de l element ib
  157. c
  158.           CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  159.           CALL ZERO (REL,LRE,LRE)
  160. c
  161. c        boucle sur les points de gauss
  162. c
  163.           ISDJC=0
  164.           DO 4004  IGAU=1,NBPGAU
  165. c
  166. c   recuperation de l'epaisseur
  167. c
  168.               IF (IFOUR.EQ.-2)THEN
  169.                   MPTVAL=IVACAR
  170.                   IF (IVACAR.NE.0) THEN
  171.                       MELVAL=IVAL(1)
  172.                       IF (MELVAL.NE.0) THEN
  173.                           IGMN=MIN(IGAU,VELCHE(/1))
  174.                           IBMN=MIN(IB,VELCHE(/2))
  175.                           DIM3=VELCHE(IGMN,IBMN)
  176.                       ELSE
  177.                           DIM3=1.D0
  178.                       ENDIF
  179.                   ENDIF
  180.               ENDIF
  181. *
  182.               CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  183.      1        DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  184.               IF(DJAC.LT.0.) ISDJC=ISDJC+1
  185.               IF(DJAC.EQ.0.) I259=IB
  186.               DJAC=ABS(DJAC)*POIGAU(IGAU)
  187.               MPTVAL=IVAMAT
  188.               IF (IVAL(1).NE.0) THEN
  189.                   MELVAL=IVAL(1)
  190.                   IGMN=MIN(IGAU,VELCHE(/1))
  191.                   IBMN=MIN(IB,VELCHE(/2))
  192.                   VALMAT(1)=VELCHE(IGMN,IBMN)
  193.               ELSE
  194.                   VALMAT(1)=0.D0
  195.               ENDIF
  196.               DJAC=DJAC*VALMAT(1)
  197.               CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  198.  4004     CONTINUE
  199.           IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  200. *          SEGINI XMATRI
  201. *          IMATTT(IB)=XMATRI
  202. c
  203. c        remplissage de xmatri
  204. c
  205.           IF ( ILUMP .EQ. 0 ) THEN
  206.               CALL REMPMT(REL,LRE,RE(1,1,ib))
  207.           ELSE
  208. c
  209. c          cas de l'opérateur LUMP
  210. c
  211.              IF (MELE.EQ.4) THEN
  212. *               lumping par la méthode physique
  213.                CALL LUMP1(REL,LRE,RE(1,1,ib),IFOUR)
  214.              ELSE
  215. *               lumping par la méthode HRZ
  216.                CALL LUMP2(REL,LRE,RE(1,1,ib),IFOUR)
  217.              ENDIF
  218.           ENDIF
  219. *          SEGDES XMATRI
  220.  3004 CONTINUE
  221.       IF(I195.NE.0) INTERR(1)=I195
  222.       IF(I195.NE.0) CALL ERREUR(195)
  223.       IF(I259.NE.0) INTERR(1)=I259
  224.       IF(I259.NE.0) CALL ERREUR(259)
  225.       SEGDES xMATRI
  226.       SEGSUP WRK1,WRK2,MVELCH
  227.       GOTO 510
  228. c_______________________________________________________________________
  229. c_______________________________________________________________________
  230. c_______________________________________________________________________
  231. c
  232. c     secteur de calcul pour element SHB8
  233. c_______________________________________________________________________
  234. c
  235.    5  CONTINUE
  236.       NBNO=NBNN
  237.       NBBB=NBNN
  238.       SEGINI WRK1,WRK2,WRK6
  239.       DO 3005  IB=1,NBELEM
  240. c
  241. c        on cherche  les coordonnees des noeuds de l element ib
  242. c
  243.           CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  244.           CALL ZERO (REL,LRE,LRE)
  245. c
  246. *
  247.           MPTVAL=IVAMAT
  248.           IF (IVAL(1).NE.0) THEN
  249.               MELVAL=IVAL(1)
  250.               IBMN=MIN(IB,VELCHE(/2))
  251.               VALMAT(1)=VELCHE(1,IBMN)
  252.           ELSE
  253.               VALMAT(1)=0.D0
  254.           ENDIF
  255.  
  256.           PROPEL(1)=VALMAT(1)
  257. C
  258. C     CALCUL DE LA MATRICE DE MASSE
  259. C
  260.          call SHB8 (3,XE,DDHOOK,PROPEL,WORK1,REL,OUT)
  261. C
  262. *          SEGINI XMATRI
  263. *          IMATTT(IB)=XMATRI
  264. c
  265. c        remplissage de xmatri
  266. c
  267.           CALL REMPMT(REL,LRE,RE(1,1,ib))
  268. *          SEGDES XMATRI
  269.  3005 CONTINUE
  270.  
  271.       SEGDES xMATRI
  272.       SEGSUP WRK1,WRK2,WRK6,MVELCH
  273.       GOTO 510
  274. c_______________________________________________________________________
  275. c_______________________________________________________________________
  276. c
  277. c     secteur de calcul pour les elements liquides
  278. c_______________________________________________________________________
  279. c
  280.   35  CONTINUE
  281. c
  282. c      ces éléments n'ont pas été testé pour l'opérateur LUMP
  283. c
  284.       IF ( ILUMP .EQ. 1 ) GOTO 99
  285. c
  286.       DIM3=1.D0
  287.       NBNO=NBNN
  288.       NBBB=NBNN
  289.       SEGINI WRK1,WRK2,WRK5
  290.       I195=0
  291.       DO 3035  IB=1,NBELEM
  292. c
  293. c        on cherche  les coordonnees des noeuds de l element ib
  294. c
  295.           CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  296.           CALL ZERO (REL,LRE,LRE)
  297.  
  298. c
  299. c        calcul des termes en p*pi
  300.  
  301.           ISDJC=0
  302.           DO 4035  IGAU=1,NBPGAU
  303.  
  304. c        calcul des coefficients de normalisation et proprietes materielles
  305.             MPTVAL=IVAMAT
  306.             DO 6035 IM=1,NMATT
  307.              IF (IVAL(IM).NE.0) THEN
  308.                MELVAL=IVAL(IM)
  309.                IGMN=MIN(IGAU,VELCHE(/1))
  310.                IBMN=MIN(IB,VELCHE(/2))
  311.                VALMAT(IM)=VELCHE(IGMN,IBMN)
  312.              ELSE
  313.                VALMAT(IM)=0.D0
  314.              ENDIF
  315.  6035       CONTINUE
  316.            RHO   = VALMAT(1)
  317.            C     = VALMAT(2)
  318.            RHOREF= VALMAT(3)
  319.            CREF  = VALMAT(4)
  320.            RLCAR = VALMAT(5)
  321. c
  322.            COEFPR= (RHOREF*CREF**2)/RLCAR
  323.            COEFPI= RHOREF*RLCAR
  324.            VML12 =-(COEFPR*COEFPI)/(RHO*C**2)
  325.            VML22 =-(COEFPI**2)/RHO
  326.  
  327. c
  328. c   recuperation de l'epaisseur
  329. c
  330.               IF (IFOUR.EQ.-2)THEN
  331.                   MPTVAL=IVACAR
  332.                   IF (IVACAR.NE.0) THEN
  333.                       MELVAL=IVAL(1)
  334.                       IF (MELVAL.NE.0) THEN
  335.                           IGMN=MIN(IGAU,VELCHE(/1))
  336.                           IBMN=MIN(IB,VELCHE(/2))
  337.                           DIM3=VELCHE(IGMN,IBMN)
  338.                       ELSE
  339.                           DIM3=1.D0
  340.                       ENDIF
  341.                   ENDIF
  342.               ENDIF
  343.               CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  344.      1        DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  345.               IF(DJAC.LT.0.) ISDJC=ISDJC+1
  346.               DJAC=ABS(DJAC)*POIGAU(IGAU)
  347.               CALL NMLNST(BGENE,DJAC,VML12,LRE,NDDL,REL)
  348.  
  349. c
  350. c        calcul des termes en pi*pi
  351. c
  352.  
  353.               CALL BLMAST(IGAU,MFR,NBNN,LRE,IFOUR,NDDL,NHRM,
  354.      1        XE,SHPTOT,SHPWRK,BLX,BLY,BLZ,BLT,DJAC)
  355.               DJAC=ABS(DJAC)*POIGAU(IGAU)
  356.               CALL BMLBST(BLX,BLY,BLZ,BLT,DJAC,VML22,IFOUR,LRE,NDDL,REL)
  357.  4035     CONTINUE
  358.           IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  359.  
  360. *          SEGINI XMATRI
  361. *          IMATTT(IB)=XMATRI
  362. c
  363. c        remplissage de xmatri
  364. c
  365.           CALL REMPMT(REL,LRE,RE(1,1,ib))
  366. *          SEGDES XMATRI
  367.  3035 CONTINUE
  368.       IF(I195.NE.0) INTERR(1)=I195
  369.       IF(I195.NE.0) CALL ERREUR(195)
  370.       SEGDES xMATRI
  371.       SEGSUP WRK1,WRK2,WRK5,MVELCH
  372.       GOTO 510
  373. c_______________________________________________________________________
  374. c
  375. c     secteur de calcul pour les elements de surface libre
  376. c_______________________________________________________________________
  377. c
  378.   48  CONTINUE
  379. c
  380. c      ces éléments n'ont pas été testé pour l'opérateur LUMP
  381. c
  382.       IF ( ILUMP .EQ. 1 ) GOTO 99
  383. c
  384.       NBNO=NBNN
  385.       NBBB=NBNN
  386.       SEGINI WRK1,WRK2
  387.       I195=0
  388.       DO 3048  IB=1,NBELEM
  389. c
  390. c        on cherche  les coordonnees des noeuds de l element ib
  391. c
  392.           CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  393.           CALL ZERO (REL,LRE,LRE)
  394. c
  395. c        calcul du coefficient de normalisation sur pi
  396. c
  397.           MPTVAL=IVAMAT
  398.           DO 5048 IM=1,NMATT
  399.               MELVAL=IVAL(IM)
  400.               IBMN=MIN(IB,VELCHE(/2))
  401.               VALMAT(IM)=VELCHE(1,IBMN)
  402.  5048     CONTINUE
  403.           RHOREF=VALMAT(1)
  404.           RLCAR = VALMAT(2)
  405. c
  406.           COEFPI= RHOREF*RLCAR
  407.           VMS =-COEFPI
  408. c
  409. c        boucle sur les points de gauss
  410. c
  411.           ISDJC=0
  412.           DO 4048  IGAU=1,NBPGAU
  413.               CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  414.      1        1.D0,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  415.               IF(DJAC.LT.0.) ISDJC=ISDJC+1
  416.               DJAC=ABS(DJAC)*POIGAU(IGAU)
  417.               CALL NMSNST(BGENE,DJAC,VMS,LRE,NDDL,REL)
  418.  4048     CONTINUE
  419.           IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  420. *         SEGINI XMATRI
  421. *          IMATTT(IB)=XMATRI
  422. c
  423. c        remplissage de xmatri
  424. c
  425.           CALL REMPMT(REL,LRE,RE(1,1,ib))
  426. *          SEGDES XMATRI
  427.  3048 CONTINUE
  428.       IF(I195.NE.0) INTERR(1)=I195
  429.       IF(I195.NE.0) CALL ERREUR(195)
  430.       SEGDES xMATRI
  431.       SEGSUP WRK1,WRK2,MVELCH
  432.       GOTO 510
  433. c_______________________________________________________________________
  434. *
  435.    99 CONTINUE
  436.       MOTERR(1:4)=NOMTP(MELE)
  437.       MOTERR(5:12)='MASSE2'
  438.       CALL ERREUR(86)
  439. *
  440.   510 CONTINUE
  441.       RETURN
  442.       END
  443.  
  444.  
  445.  
  446.  
  447.  
  448.  
  449.  
  450.  

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