Télécharger tadve8.eso

Retour à la liste

Numérotation des lignes :

tadve8
  1. C TADVE8 SOURCE OF166741 25/02/21 21:18:43 12166
  2.  
  3. C=======================================================================
  4. C= T A D V E 8 =
  5. C= ----------- =
  6. C= =
  7. C= Fonction : =
  8. C= ---------- =
  9. C= Calcul de la matrice d'ADVECTION pour les =
  10. C= les elements finis MASSIFs a integration NUMERIQUE =
  11. C= =
  12. C= Parametres : (E)=Entree (S)=Sortie =
  13. C= ------------ =
  14. * NEF (E) NUMERO DE L'ELEMENT-FINI DANS NOMTP (VOIR CCHAMP)
  15. * IPMAIL E) NUMERO DU MAILLAGE ELEMENTAIRE CONSIDERE
  16. *
  17. * AUTEUR, DATE DE CREATION:
  18. * -------------------------
  19. * MARINO ARROYO, 18 MAI 1999
  20. *
  21. * LANGAGE:
  22. * --------
  23. * ESOPE + FORTRAN77
  24. *
  25. ************************************************************************
  26. SUBROUTINE TADVE8 (NEF,IPMAIL,IPINTE,IMATE,IVAMAT,NVAMAT,ISYMM,
  27. & IPMATR,NLIGR)
  28.  
  29. IMPLICIT INTEGER(I-N)
  30. IMPLICIT REAL*8(A-H,O-Z)
  31.  
  32. -INC PPARAM
  33. -INC CCOPTIO
  34. -INC CCREEL
  35. -INC CCHAMP
  36.  
  37. -INC SMCHAML
  38. -INC SMCOORD
  39. -INC SMELEME
  40. -INC SMINTE
  41. -INC SMRIGID
  42.  
  43. -INC TMPTVAL
  44.  
  45. SEGMENT,MMAT1
  46. REAL*8 CEL(NBNN,NBNN),XE(3,NBNN)
  47. REAL*8 SHP(6,NBNN),GRAD(NDIM,NBNN)
  48. C* REAL*8 FORME(NBNN),V77(NBNN),V22(IDIM) <- A verifier pour V22
  49. REAL*8 FORME(NBNN),V77(NBNN),V22(NDIM)
  50. REAL*8 CMAT(NDIM,NDIM),CMAT1(IDIM,IDIM),CMAT2(IDIM,IDIM)
  51. ENDSEGMENT
  52.  
  53. C SEGMENT ,MAXE
  54. C REAL*8 TXR(IDIM,IDIM),XLOC(3,3),XGLOB(3,3)
  55. C ENDSEGMENT
  56.  
  57. C 1 - INITIALISATIONS ET VERIFICATIONS
  58. C ======================================
  59. MELEME = IPMAIL
  60. c* SEGACT,MELEME
  61. NBNN = NUM(/1)
  62. NBELEM = NUM(/2)
  63. C =====
  64. MINTE = IPINTE
  65. c* SEGACT,MINTE
  66. NBPGAU = POIGAU(/1)
  67. C =====
  68. MPTVAL = IVAMAT
  69. c* SEGACT,MPTVAL
  70. C =====
  71. XMATRI = IPMATR
  72. c* SEGACT,xMATRI*MOD
  73. c* NLIGRP = NBNN = NLIGR
  74. c* NLIGRD = NBNN = NLIGR
  75. C =====
  76. C Recuperation des fonctions de forme et de leurs derivees au
  77. C centre de gravite de l'element pour le calcul des axes locaux
  78. C d'orthotropie ou d'anisotropie
  79. C =====
  80. C IF (IMATE.EQ.2 .OR.IMATE.EQ.3) THEN
  81. C NLG = NUMGEO(NEF)
  82. C CALL RESHPT(1,NBNN,NLG,NEF,0,IPINT1,IOK)
  83. Cc*of IF (IOK.EQ.0) GOTO 999
  84. C MINTE1 = IPINT1
  85. C SEGACT,MINTE1
  86. C NBSH = MINTE1.SHPTOT(/2)
  87. C ENDIF
  88.  
  89. C =====
  90. C Initialisation des segments de travail
  91. C =====
  92. IF (IFOMOD.EQ.1) THEN
  93. NDIM = 3
  94. ELSE
  95. NDIM = IDIM
  96. ENDIF
  97. SEGINI,MMAT1
  98. C IF (IMATE.EQ.2 .OR. IMATE.EQ.3) THEN
  99. C SEGINI,MAXE
  100. C ENDIF
  101.  
  102. C 2 - BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IPMAIL
  103. C ============================================================
  104. DO IEL = 1, NBELEM
  105. *
  106. * MISE A ZERO DU TABLEAU CEL
  107. *
  108. CALL ZERO(CEL,NBNN,NBNN)
  109. *
  110. * COORDONNEES DES NOEUDS DE L'ELEMENT IEL DANS LE REPERE GLOBAL
  111. *
  112. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
  113. *
  114. CB215821 : En ADVECTION, les vitesses sont donnees dans le repere global
  115. CC Calcul des axes locaux d'orthotropie ou d'anisotropie
  116. C IF (IMATE.EQ.2 .OR. IMATE.EQ.3) THEN
  117. C CALL RLOCAL(XE,MINTE1.SHPTOT,NBSH,NBNN,TXR)
  118. C IF (nbsh.EQ.-1) THEN
  119. C CALL ERREUR(525)
  120. C GOTO 9990
  121. C ENDIF
  122. C ENDIF
  123. *
  124. * BOUCLE SUR LES POINTS DE GAUSS
  125. *
  126. IFOIS = 0
  127.  
  128. DO IGAU = 1, NBPGAU
  129. *
  130. * CALCUL DE LA MATRICE GRADIENT DES FONCTIONS DE FORME ET
  131. * DU JACOBIEN,EN UN POINT DE GAUSS
  132. *
  133. CALL TCOND5(IGAU,NBNN,NDIM,XE,SHPTOT,SHP,GRAD,DJAC)
  134. IF (IERR.NE.0) GOTO 9990
  135. IF (DJAC.LT.XZERO) IFOIS=IFOIS+1
  136. * Marino calcul de la matrice des fonctions de forme et confirmation du jacobien
  137. CALL CAPA4(NEF,IGAU,NBNN,XE,SHPTOT,SHP,FORME,DJAC2)
  138. IF ((ABS(DJAC-DJAC2)).GT.1.d-2) THEN
  139. WRITE(*,*) '###ERREUR DANS ADVE: Marino jacob diff '
  140. INTERR(1) = iElt
  141. CALL ERREUR(259)
  142. GOTO 9990
  143. ENDIF
  144. DJAC = ABS(DJAC)
  145. IF (DJAC.LT.XPETIT) THEN
  146. INTERR(1) = iElt
  147. CALL ERREUR(259)
  148. GOTO 9990
  149. ENDIF
  150. DJAC = DJAC*POIGAU(IGAU)
  151.  
  152. * Recuperation des valeurs des composantes du champ vectoriel
  153. DO i = 1, IDIM
  154. IF (IVAL(i).NE.0) THEN
  155. MELVAL = IVAL(i)
  156. IBMN = MIN(IEL ,VELCHE(/2))
  157. IGMN = MIN(IGAU,VELCHE(/1))
  158. V22(i) = DJAC*VELCHE(IGMN,IBMN)
  159. ELSE
  160. V22(i) = XZERO
  161. ENDIF
  162. ENDDO
  163.  
  164. C La vitesse est donnee dans le repere global (elements massifs)
  165. C Il n'y a pas a distinguer les cas ISOTROPE, ORTHOTROPE et ANISOTROPE
  166. DO i = 1, NBNN
  167. r_z = XZERO
  168. DO j = 1, NDIM
  169. r_z = r_z + GRAD(j,i)*V22(j)
  170. ENDDO
  171. V77(i) = r_z
  172. ENDDO
  173.  
  174. * CAS SYMETRIQUE
  175. IF (ISYMM.EQ.1) THEN
  176. DO i = 1, NBNN
  177. r_z = V77(i)
  178. DO j = 1, i
  179. CEL(i,j) = CEL(i,j)
  180. & + (r_z*FORME(j) + V77(j)*FORME(i))/2.D0
  181. ENDDO
  182. ENDDO
  183. * NON SYMETRIQUE
  184. ELSE
  185. DO i = 1, NBNN
  186. r_z = V77(i)
  187. DO j = 1, NBNN
  188. CEL(j,i) = CEL(j,i) + (r_z *FORME(j))
  189. ENDDO
  190. ENDDO
  191. ENDIF
  192. ENDDO
  193.  
  194. C Erreur si, en un point de Gauss, le jacobien change de signe.
  195. IF (IFOIS.NE.0.AND.IFOIS.NE.NBPGAU) THEN
  196. INTERR(1) = iElt
  197. CALL ERREUR(195)
  198. GOTO 9990
  199. ENDIF
  200.  
  201. * REMPLISSAGE DE XMATRI
  202. IF (ISYMM.EQ.1) THEN
  203. CALL REMPMT(CEL,NLIGR,RE(1,1,iel))
  204. ELSE
  205. CALL REMPMS(CEL,NLIGR,RE(1,1,iel))
  206. ENDIF
  207. C
  208. ENDDO
  209. *
  210. * DESACTIVATION DES SEGMENTS
  211. *
  212. C 3 - MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS
  213. C ====================================================
  214. 9990 CONTINUE
  215. SEGSUP,MMAT1
  216. C IF (IMATE.EQ.2.OR.IMATE.EQ.3) THEN
  217. C SEGDES,MINTE1
  218. C SEGSUP,MAXE
  219. C ENDIF
  220.  
  221. RETURN
  222. END
  223.  
  224.  
  225.  

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