Télécharger rigdif.eso

Retour à la liste

Numérotation des lignes :

  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 CCOPTIO
  28. -INC CCREEL
  29.  
  30. -INC SMCHAML
  31. -INC SMCOORD
  32. -INC SMELEME
  33. -INC SMINTE
  34. -INC SMRIGID
  35.  
  36. SEGMENT MWKELT
  37. REAL*8 DFICK(LDIFF,LDIFF),BGRDIF(LDIFF,LRE)
  38. REAL*8 XEL(3,NBNN),SHP(6,NBNN)
  39. REAL*8 VALMAT(NVMAT)
  40. ENDSEGMENT
  41.  
  42. SEGMENT MWKMAT
  43. REAL*8 XLOC(IDIM,IDIM),XGLOB(IDIM,IDIM),TXR(IDIM,IDIM)
  44. REAL*8 DFICK1(LDIFF,LDIFF)
  45. ENDSEGMENT
  46.  
  47. SEGMENT MPTVAL
  48. INTEGER IPOS(NS),NSOF(NS)
  49. INTEGER IVAL(NCOSOU)
  50. CHARACTER*16 TYVAL(NCOSOU)
  51. ENDSEGMENT
  52.  
  53. MINTE = IPMINT1
  54. MELEME = IPMAIL
  55. NBNN = NUM(/1)
  56. NBELEM = NUM(/2)
  57. XMATRI = IPMATR
  58. MPTVAL = IVAMAT
  59.  
  60. SEGINI,MWKELT
  61. IWKELT = MWKELT
  62.  
  63. MWKMAT = 0
  64. IF (MATE.EQ.2.OR.MATE.EQ.3) THEN
  65. NLG = NUMGEO(MELE)
  66. CALL RESHPT(1,NBNN,NLG,MELE,0,IPMINT2,IRT1)
  67. MINTE2 = IPMINT2
  68. SEGACT,MINTE2
  69. NBSH = MINTE2.SHPTOT(/2)
  70. SEGINI,MWKMAT
  71. ENDIF
  72. IWKMAT = MWKMAT
  73.  
  74. C-------------------------
  75. C Boucle sur les elements
  76. C-------------------------
  77. DO IEL = 1,NBELEM
  78. C - Recuperation des coordonnees des noeuds de l element IEL
  79. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XEL)
  80. C - Calcul des axes locaux dans les cas orthotrope et anisotrope
  81. IF (MATE.EQ.2.OR.MATE.EQ.3) THEN
  82. CALL RLOCAL(XEL,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  83. IF (NBSH.EQ.-1) THEN
  84. CALL ERREUR(525)
  85. GOTO 999
  86. ENDIF
  87. ENDIF
  88. C-- -- -- -- -- -- -- -- --
  89. C - Boucle sur les points de Gauss
  90. C-- -- -- -- -- -- -- -- --
  91. ISDJC = 0
  92. DO IGAU = 1, NBPGAU
  93. C -- Calcul de la matrice Bdif et du jacobien au point de Gauss IGAU
  94. CALL BDIFF(XEL,SHPTOT(1,1,IGAU),NBNN,LDIFF,1, SHP,BGRDIF,DJAC)
  95. IF (DJAC.LT.0.) ISDJC = ISDJC+1
  96. IF (DJAC.EQ.0.) THEN
  97. INTERR(1) = IEL
  98. CALL ERREUR(259)
  99. GOTO 999
  100. ENDIF
  101. DJAC = ABS(DJAC)*POIGAU(IGAU)
  102. C -- Recuperation des proprietes materielles (IGAU)
  103. DO i = 1, NVMAT
  104. MELVAL = IVAL(i)
  105. IEMN = MIN(IEL ,VELCHE(/2))
  106. IGMN = MIN(IGAU,VELCHE(/1))
  107. VALMAT(i) = VELCHE(IGMN,IEMN)
  108. ENDDO
  109. C -- Calcul de la matrice de diffusion lineaire Fick (IGAU)
  110. CALL DOFICK(MATE,IDIM, IWKELT,IWKMAT)
  111. C -- Contribution a la matrice de rigidite elementaire (IGAU - IEL)
  112. CALL BDBST(BGRDIF,DJAC,DFICK,LRE,LDIFF,RE(1,1,IEL))
  113. C-- -- -- -- -- -- -- -- --
  114. ENDDO
  115. C-- -- -- -- -- -- -- -- --
  116. IF (ISDJC.NE.0 .AND. ISDJC.NE.NBPGAU) THEN
  117. INTERR(1) = IEL
  118. CALL ERREUR(195)
  119. GOTO 999
  120. ENDIF
  121. C-------------------------
  122. ENDDO
  123. C-------------------------
  124.  
  125. 999 CONTINUE
  126. IF (MATE.EQ.2.OR.MATE.EQ.3) THEN
  127. SEGDES,MINTE2
  128. SEGSUP,MWKMAT
  129. ENDIF
  130. SEGSUP,MWKELT
  131.  
  132. RETURN
  133. END
  134.  
  135.  
  136.  
  137.  

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