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