Télécharger sigele.eso

Retour à la liste

Numérotation des lignes :

  1. C SIGELE SOURCE BP208322 17/03/01 21:18:19 9325
  2.  
  3. SUBROUTINE SIGELE (MELE,IELE,IPMAIL,NBPGAU,IPMINT1,NDEP,IVADEP,
  4. & LPERM,LRE,MATE,IVAMAT,NVMAT, IVASTR)
  5.  
  6. *----------------------------------------------------------------------*
  7. * CALCUL DES INDUCTIONS ELECTRIQUES (FORMULATION 'ELECTROSTATIQUE') *
  8. *----------------------------------------------------------------------*
  9. * ENTREES : *
  10. * ________ *
  11. * MELE Numero de l'element fini *
  12. * IPMAIL Pointeur sur un segment MELEME *
  13. * IPMINT1 Pointeur sur un segment MINTE *
  14. * NBPGAU Nombre de point d'integration pour la rigidite *
  15. * MATE Numero du materiau *
  16. * IVAMAT Pointeur sur un segment MPTVAL pour le materiau ou *
  17. * NVMAT Nombre de composantes de materiau *
  18. * *
  19. * SORTIES : *
  20. * ________ *
  21. * IVASTR Pointeur sur *
  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.  
  35. SEGMENT MWKELT
  36. REAL*8 DPERM(LPERM,LPERM),BGRELE(LPERM,LRE)
  37. REAL*8 XEL(3,NBNN),SHP(6,NBNN)
  38. REAL*8 VALMAT(NVMAT)
  39. ENDSEGMENT
  40.  
  41. SEGMENT MWKMAT
  42. REAL*8 XLOC(3,3),XGLOB(3,3),TXR(IDIM,IDIM)
  43. REAL*8 DPERM1(LPERM,LPERM)
  44. ENDSEGMENT
  45.  
  46. SEGMENT MWKELE
  47. REAL*8 DDLELE(LRE),FLUELE(LPERM)
  48. ENDSEGMENT
  49.  
  50. SEGMENT MPTVAL
  51. INTEGER IPOS(NS),NSOF(NS)
  52. INTEGER IVAL(NCOSOU)
  53. CHARACTER*16 TYVAL(NCOSOU)
  54. ENDSEGMENT
  55.  
  56. MINTE = IPMINT1
  57. MELEME = IPMAIL
  58. NBNN = NUM(/1)
  59. NBELEM = NUM(/2)
  60.  
  61. SEGINI,MWKELT
  62. IWKELT = MWKELT
  63.  
  64. MWKMAT = 0
  65. IF (MATE.EQ.2.OR.MATE.EQ.3) THEN
  66. CALL RESHPT(1,NBNN,IELE,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. SEGINI,MWKELE
  75.  
  76. C-------------------------
  77. C Boucle sur les elements
  78. C-------------------------
  79. DO IEL = 1,NBELEM
  80. C - Recuperation des coordonnees des noeuds de l element IEL
  81. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XEL)
  82. C - Calcul des axes locaux dans les cas orthotrope et anisotrope
  83. IF (MATE.EQ.2.OR.MATE.EQ.3) THEN
  84. CALL RLOCAL(XEL,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  85. IF (NBSH.EQ.-1) THEN
  86. CALL ERREUR(525)
  87. GOTO 999
  88. ENDIF
  89. ENDIF
  90. C - Recuperation des potentiels electriques aux noeuds de l element IEL
  91. MPTVAL = IVADEP
  92. IE = 1
  93. DO IGAU = 1, NBNN
  94. DO ICOMP = 1, NDEP
  95. MELVAL = IVAL(ICOMP)
  96. IGMN = MIN(IGAU,VELCHE(/1))
  97. IEMN = MIN(IEL ,VELCHE(/2))
  98. DDLELE(IE) = VELCHE(IGMN,IEMN)
  99. IE = IE+1
  100. ENDDO
  101. ENDDO
  102. C-- -- -- -- -- -- -- -- --
  103. C - Boucle sur les points de Gauss
  104. C-- -- -- -- -- -- -- -- --
  105. ISDJC = 0
  106. DO IGAU = 1, NBPGAU
  107. C -- Calcul de la matrice Bel et du jacobien au point de Gauss IGAU
  108. CALL BELEC(XEL,SHPTOT(1,1,IGAU),NBNN,LPERM,-1,
  109. & SHP,BGRELE,DJAC)
  110. IF (DJAC.LT.0.) ISDJC = ISDJC+1
  111. IF (DJAC.EQ.0.) THEN
  112. INTERR(1) = IEL
  113. CALL ERREUR(259)
  114. GOTO 999
  115. ENDIF
  116. C -- Recuperation des proprietes materielles (IGAU)
  117. MPTVAL = IVAMAT
  118. DO i = 1, NVMAT
  119. MELVAL = IVAL(i)
  120. IEMN = MIN(IEL ,VELCHE(/2))
  121. IGMN = MIN(IGAU,VELCHE(/1))
  122. VALMAT(i) = VELCHE(IGMN,IEMN)
  123. ENDDO
  124. C -- Calcul de la matrice de permittivite dielectrique (IGAU)
  125. CALL PERMEL(MATE,IDIM, IWKELT,IWKMAT)
  126. C -- Calcul de l'induction electrique Del (IGAU)
  127. CALL DBST(BGRELE,DPERM,DDLELE,LRE,LPERM,FLUELE)
  128. C -- Remplissage du segment contenant Del = "contraintes"
  129. MPTVAL = IVASTR
  130. DO ICOMP = 1, LPERM
  131. MELVAL = IVAL(ICOMP)
  132. IEMN = MIN(IEL,VELCHE(/2))
  133. VELCHE(IGAU,IEMN) = FLUELE(ICOMP)
  134. ENDDO
  135. C-- -- -- -- -- -- -- -- --
  136. ENDDO
  137. C-- -- -- -- -- -- -- -- --
  138. IF (ISDJC.NE.0 .AND. ISDJC.NE.NBPGAU) THEN
  139. INTERR(1) = IEL
  140. CALL ERREUR(195)
  141. GOTO 999
  142. ENDIF
  143. C-------------------------
  144. ENDDO
  145. C-------------------------
  146.  
  147. 999 CONTINUE
  148. IF (MATE.EQ.2.OR.MATE.EQ.3) THEN
  149. SEGDES,MINTE2
  150. SEGSUP,MWKMAT
  151. ENDIF
  152. SEGSUP,MWKELT
  153. SEGSUP,MWKELE
  154.  
  155. RETURN
  156. END
  157.  
  158.  
  159.  
  160.  

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