Télécharger la plaquette Cast3M


fr en

Télécharger tadve8.eso

Retour à la liste

Numérotation des lignes : 

tadve8

  1. C TADVE8    SOURCE    JK148537  25/12/15    21:15:07     12425          
  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,ITYP1)
  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.       SEGMENT,MMAT2
  54.         REAL*8 CEM(NLIGR,NLIGR)
  55.       ENDSEGMENT
  56.  
  57. C      SEGMENT ,MAXE
  58. C        REAL*8 TXR(IDIM,IDIM),XLOC(3,3),XGLOB(3,3)
  59. C      ENDSEGMENT
  60.  
  61. C  1 - INITIALISATIONS ET VERIFICATIONS
  62. C ======================================
  63.       MELEME = IPMAIL
  64. c*      SEGACT,MELEME
  65.       NBNN   = NUM(/1)
  66.       NBELEM = NUM(/2)
  67. C =====
  68.       MINTE = IPINTE
  69. c*      SEGACT,MINTE
  70.       NBPGAU = POIGAU(/1)
  71. C =====
  72.       MPTVAL = IVAMAT
  73. c*      SEGACT,MPTVAL
  74. C =====
  75.       XMATRI = IPMATR
  76. c*      SEGACT,xMATRI*MOD
  77. c*      NLIGRP = NBNN = NLIGR
  78. c*      NLIGRD = NBNN = NLIGR
  79. C =====
  80. C Recuperation des fonctions de forme et de leurs derivees au
  81. C        centre de gravite de l'element pour le calcul des axes locaux
  82. C        d'orthotropie ou d'anisotropie
  83. C =====
  84. C      IF (IMATE.EQ.2 .OR.IMATE.EQ.3) THEN
  85. C        NLG = NUMGEO(NEF)
  86. C        CALL RESHPT(1,NBNN,NLG,NEF,0,IPINT1,IOK)
  87. Cc*of      IF (IOK.EQ.0) GOTO 999
  88. C        MINTE1 = IPINT1
  89. C        SEGACT,MINTE1
  90. C        NBSH = MINTE1.SHPTOT(/2)
  91. C      ENDIF
  92.  
  93. C =====
  94. C Initialisation des segments de travail
  95. C =====
  96.       IF (IFOMOD.EQ.1) THEN
  97.          NDIM = 3
  98.       ELSE
  99.          NDIM = IDIM
  100.       ENDIF
  101.       SEGINI,MMAT1
  102.       if (ityp1.eq.4) SEGINI,MMAT2
  103. C      IF (IMATE.EQ.2 .OR. IMATE.EQ.3) THEN
  104. C        SEGINI,MAXE
  105. C      ENDIF
  106.  
  107. C  2 - BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IPMAIL
  108. C ============================================================
  109.       DO IEL = 1, NBELEM
  110. *
  111. * MISE A ZERO DU TABLEAU CEL
  112. *
  113.         CALL ZERO(CEL,NBNN,NBNN)
  114.         if (ityp1.eq.4) CALL ZERO(CEM,NLIGR,NLIGR) 
  115. *
  116. * COORDONNEES DES NOEUDS DE L'ELEMENT IEL DANS LE REPERE GLOBAL
  117. *
  118.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
  119. *
  120. CB215821 : En ADVECTION, les vitesses sont donnees dans le repere global
  121. CC Calcul des axes locaux d'orthotropie ou d'anisotropie
  122. C        IF (IMATE.EQ.2 .OR. IMATE.EQ.3) THEN
  123. C          CALL RLOCAL(XE,MINTE1.SHPTOT,NBSH,NBNN,TXR)
  124. C          IF (nbsh.EQ.-1) THEN
  125. C            CALL ERREUR(525)
  126. C            GOTO 9990
  127. C          ENDIF
  128. C        ENDIF
  129. *
  130. *  BOUCLE SUR LES POINTS DE GAUSS
  131. *
  132.         IFOIS = 0
  133.  
  134.         DO IGAU = 1, NBPGAU
  135. *
  136. *           CALCUL DE LA MATRICE GRADIENT DES FONCTIONS DE FORME ET
  137. *           DU JACOBIEN,EN UN POINT DE GAUSS
  138. *
  139.           CALL TCOND5(IGAU,NBNN,NDIM,XE,SHPTOT,SHP,GRAD,DJAC)
  140.           IF (IERR.NE.0) GOTO 9990
  141.           IF (DJAC.LT.XZERO) IFOIS=IFOIS+1
  142. *  Marino calcul de la matrice des fonctions de forme et confirmation du jacobien
  143.           CALL CAPA4(NEF,IGAU,NBNN,XE,SHPTOT,SHP,FORME,DJAC2)
  144.           IF ((ABS(DJAC-DJAC2)).GT.1.d-2) THEN
  145.             WRITE(*,*) '###ERREUR DANS ADVE: Marino jacob diff '
  146.             INTERR(1) = iElt
  147.             CALL ERREUR(259)
  148.             GOTO 9990
  149.           ENDIF
  150.           DJAC = ABS(DJAC)
  151.           IF (DJAC.LT.XPETIT) THEN
  152.             INTERR(1) = iElt
  153.             CALL ERREUR(259)
  154.             GOTO 9990
  155.           ENDIF
  156.           DJAC = DJAC*POIGAU(IGAU)
  157.  
  158.           xrho = 1.d0
  159.           xc = 1.d0
  160.           if (ityp1.eq.1) then 
  161.             xc = 0.d0
  162.             xrho = 0.d0
  163.           endif
  164.           if (ityp1.eq.4) then
  165.             xrho = 0.d0
  166.           endif
  167. * Recuperation des valeurs des composantes du champ vectoriel
  168. *          DO i = 1, IDIM
  169.           DO i = 1, ival(/1)
  170.             IF (IVAL(i).NE.0) THEN
  171.               MELVAL = IVAL(i)
  172.               IBMN = MIN(IEL ,VELCHE(/2))
  173.               IGMN = MIN(IGAU,VELCHE(/1))
  174.               if (i.le.IDIM) then
  175.                 V22(i) = DJAC*VELCHE(IGMN,IBMN)
  176.               elseif (i.eq.IDIM + 1) then
  177.                 xrho = VELCHE(IGMN,IBMN)
  178.               elseif (i.eq.IDIM + 2) then
  179.                 if (ityp1.eq.1) xc = VELCHE(IGMN,IBMN)
  180.               endif 
  181.             ELSE
  182.               if (i.le.IDIM) then
  183.                 V22(i) = XZERO
  184.               endif
  185.             ENDIF
  186.           ENDDO
  187.  
  188. C         La vitesse est donnee dans le repere global (elements massifs)
  189. C         Il n'y a pas a distinguer les cas ISOTROPE, ORTHOTROPE et ANISOTROPE
  190.           DO i = 1, NBNN
  191.             r_z = XZERO
  192.             DO j = 1, NDIM
  193.               r_z = r_z + GRAD(j,i)*V22(j)
  194.             ENDDO
  195.             V77(i) = r_z * xrho *xc
  196.           ENDDO
  197.  
  198.  
  199. * CAS SYMETRIQUE
  200.           IF (ISYMM.EQ.1) THEN
  201.             DO i = 1, NBNN
  202.               r_z = V77(i)
  203.               LI = idim*(i-1)
  204.               DO j = 1, i
  205.                 CEL(i,j) = CEL(i,j)
  206.      &                   + (r_z*FORME(j) + V77(j)*FORME(i))/2.D0
  207.                 LJ = idim*(j - 1)
  208.                 if (ityp1.eq.4) then
  209.                   do k = 1,IDIM
  210.                     CEM(LI + k,LJ + k) = CEL(i,j)
  211.                   enddo
  212.                 endif
  213.               ENDDO
  214.             ENDDO
  215. * NON SYMETRIQUE
  216.           ELSE
  217.             DO i = 1, NBNN
  218.               r_z = V77(i)
  219.               LI = idim*(i-1)
  220.               DO j = 1, NBNN
  221.                 CEL(j,i) = CEL(j,i) + (r_z *FORME(j))
  222.                 LJ = idim*(j - 1)
  223.                 if (ityp1.eq.4) then
  224.                   do k = 1,IDIM
  225.                     CEM(LJ + k,LI + k) = CEL(j,i)
  226.                   enddo
  227.                 endif 
  228.               ENDDO
  229.             ENDDO
  230.           ENDIF
  231.         ENDDO
  232.  
  233. C Erreur si, en un point de Gauss, le jacobien change de signe.
  234.         IF (IFOIS.NE.0.AND.IFOIS.NE.NBPGAU) THEN
  235.           INTERR(1) = iElt
  236.           CALL ERREUR(195)
  237.           GOTO 9990
  238.         ENDIF
  239.  
  240. * REMPLISSAGE DE XMATRI
  241.         IF (ISYMM.EQ.1) THEN
  242.           if (ityp1.eq.4) then
  243.             CALL REMPMT(CEM,NLIGR,RE(1,1,iel))
  244.           else
  245.             CALL REMPMT(CEL,NLIGR,RE(1,1,iel))
  246.           endif
  247.         ELSE
  248.           if (ityp1.eq.4) then
  249.             CALL REMPMS(CEM,NLIGR,RE(1,1,iel))
  250.           else
  251.             CALL REMPMS(CEL,NLIGR,RE(1,1,iel))
  252.           endif
  253.         ENDIF
  254. C
  255.       ENDDO
  256. *
  257. *     DESACTIVATION DES SEGMENTS
  258. *
  259. C  3 - MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS
  260. C ====================================================
  261.  9990   CONTINUE
  262.       SEGSUP,MMAT1
  263.       if (ityp1.eq.4) segsup MMAT2
  264. C      IF (IMATE.EQ.2.OR.IMATE.EQ.3) THEN
  265. C        SEGDES,MINTE1
  266. C        SEGSUP,MAXE
  267. C      ENDIF
  268.  
  269.       RETURN
  270.       END
  271.  
  272.  
  273.  
  274.  
  275.  

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