Télécharger la plaquette Cast3M


fr en

Télécharger rigdif.eso

Retour à la liste

Numérotation des lignes : 

rigdif

  1. C RIGDIF    SOURCE    KICH      14/07/16    21:16:05     8101
  2.  
  3.       SUBROUTINE RIGDIF (MATE,MELE,NBPGAU,LDIFF,LRE,IPMAIL,IPMINT1,
  4.      &                   IVAMAT,NVMAT, IPMATR)
  5.  
  6. *----------------------------------------------------------------------*
  7. *     CALCUL DE LA RIGIDITE POUR LA FORMULATION 'DIFFUSION'            *
  8. *----------------------------------------------------------------------*
  9. *   ENTREES :                                                          *
  10. *   ________                                                           *
  11. *        MATE     Numero du materiau                                   *
  12. *        MELE     Numero de l'element fini                             *
  13. *        IPMAIL   Pointeur sur un segment  MELEME                      *
  14. *        IPMINT   Pointeur sur un segment MINTE                        *
  15. *        NBPGAU   Nombre de point d'integration pour la rigidite       *
  16. *        IVAMAT   Pointeur sur un segment MPTVAL pour le materiau ou   *
  17. *        NVMAT    Nombre de composante de materiau (IMAT=1)            *
  18. *                                                                      *
  19. *   SORTIES :                                                          *
  20. *   ________                                                           *
  21. *        IPMATR   pointeur sur la rigidite de la sous-zone             *
  22. *----------------------------------------------------------------------*
  23.  
  24.       IMPLICIT INTEGER(I-N)
  25.       IMPLICIT REAL*8(A-H,O-Z)
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC CCREEL
  30.  
  31. -INC SMCHAML
  32. -INC SMCOORD
  33. -INC SMELEME
  34. -INC SMINTE
  35. -INC SMRIGID
  36.  
  37.       SEGMENT MWKELT
  38.         REAL*8 DFICK(LDIFF,LDIFF),BGRDIF(LDIFF,LRE)
  39.         REAL*8 XEL(3,NBNN),SHP(6,NBNN)
  40.         REAL*8 VALMAT(NVMAT)
  41.       ENDSEGMENT
  42.  
  43.       SEGMENT MWKMAT
  44.         REAL*8 XLOC(IDIM,IDIM),XGLOB(IDIM,IDIM),TXR(IDIM,IDIM)
  45.         REAL*8 DFICK1(LDIFF,LDIFF)
  46.       ENDSEGMENT
  47.  
  48.       SEGMENT MPTVAL
  49.         INTEGER IPOS(NS),NSOF(NS)
  50.         INTEGER IVAL(NCOSOU)
  51.         CHARACTER*16 TYVAL(NCOSOU)
  52.       ENDSEGMENT
  53.  
  54.       MINTE = IPMINT1
  55.       MELEME = IPMAIL
  56.       NBNN   = NUM(/1)
  57.       NBELEM = NUM(/2)
  58.       XMATRI = IPMATR
  59.       MPTVAL = IVAMAT
  60.  
  61.       SEGINI,MWKELT
  62.       IWKELT = MWKELT
  63.  
  64.       MWKMAT = 0
  65.       IF (MATE.EQ.2.OR.MATE.EQ.3) THEN
  66.         NLG = NUMGEO(MELE)
  67.         CALL RESHPT(1,NBNN,NLG,MELE,0,IPMINT2,IRT1)
  68.         MINTE2 = IPMINT2
  69.         SEGACT,MINTE2
  70.         NBSH = MINTE2.SHPTOT(/2)
  71.         SEGINI,MWKMAT
  72.       ENDIF
  73.       IWKMAT = MWKMAT
  74.  
  75. C-------------------------
  76. C Boucle sur les elements
  77. C-------------------------
  78.       DO IEL = 1,NBELEM
  79. C - Recuperation des coordonnees des noeuds de l element IEL
  80.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XEL)
  81. C - Calcul des axes locaux dans les cas orthotrope et anisotrope
  82.         IF (MATE.EQ.2.OR.MATE.EQ.3) THEN
  83.           CALL RLOCAL(XEL,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  84.           IF (NBSH.EQ.-1) THEN
  85.             CALL ERREUR(525)
  86.             GOTO 999
  87.           ENDIF
  88.         ENDIF
  89. C--  --  --  --  --  --  --  --  --
  90. C - Boucle sur les points de Gauss
  91. C--  --  --  --  --  --  --  --  --
  92.         ISDJC = 0
  93.         DO IGAU = 1, NBPGAU
  94. C -- Calcul de la matrice Bdif et du jacobien au point de Gauss IGAU
  95.           CALL BDIFF(XEL,SHPTOT(1,1,IGAU),NBNN,LDIFF,1, SHP,BGRDIF,DJAC)
  96.           IF (DJAC.LT.0.) ISDJC = ISDJC+1
  97.           IF (DJAC.EQ.0.) THEN
  98.             INTERR(1) = IEL
  99.             CALL ERREUR(259)
  100.             GOTO 999
  101.           ENDIF
  102.           DJAC = ABS(DJAC)*POIGAU(IGAU)
  103. C -- Recuperation des proprietes materielles (IGAU)
  104.           DO i = 1, NVMAT
  105.             MELVAL = IVAL(i)
  106.             IEMN = MIN(IEL ,VELCHE(/2))
  107.             IGMN = MIN(IGAU,VELCHE(/1))
  108.             VALMAT(i) = VELCHE(IGMN,IEMN)
  109.           ENDDO
  110. C -- Calcul de la matrice de diffusion lineaire Fick (IGAU)
  111.           CALL DOFICK(MATE,IDIM, IWKELT,IWKMAT)
  112. C -- Contribution a la matrice de rigidite elementaire (IGAU - IEL)
  113.           CALL BDBST(BGRDIF,DJAC,DFICK,LRE,LDIFF,RE(1,1,IEL))
  114. C--  --  --  --  --  --  --  --  --
  115.         ENDDO
  116. C--  --  --  --  --  --  --  --  --
  117.         IF (ISDJC.NE.0 .AND. ISDJC.NE.NBPGAU) THEN
  118.           INTERR(1) = IEL
  119.           CALL ERREUR(195)
  120.           GOTO 999
  121.         ENDIF
  122. C-------------------------
  123.       ENDDO
  124. C-------------------------
  125.  
  126.  999  CONTINUE
  127.       IF (MATE.EQ.2.OR.MATE.EQ.3) THEN
  128.        SEGDES,MINTE2
  129.        SEGSUP,MWKMAT
  130.       ENDIF
  131.       SEGSUP,MWKELT
  132.  
  133.       RETURN
  134.       END
  135.  
  136.  
  137.  
  138.  

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