1 : C TADVE8 SOURCE CHAT 12/06/07 21:16:06 7389 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 CCOPTIO 33 : -INC CCREEL 34 : -INC CCHAMP 35 : 36 : -INC SMCHAML 37 : -INC SMCOORD 38 : -INC SMELEME 39 : -INC SMINTE 40 : -INC SMRIGID 41 : 42 : SEGMENT MPTVAL 43 : INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU) 44 : CHARACTER*16 TYVAL(NCOSOU) 45 : ENDSEGMENT 46 : 47 : SEGMENT,MMAT1 48 : REAL*8 CEL(NBNN,NBNN),XE(3,NBNN) 49 : REAL*8 SHP(6,NBNN),GRAD(NDIM,NBNN) 50 : C* REAL*8 FORME(NBNN),V77(NBNN),V22(IDIM) <- A verifier pour V22 51 : REAL*8 FORME(NBNN),V77(NBNN),V22(NDIM) 52 : REAL*8 CMAT(NDIM,NDIM),CMAT1(IDIM,IDIM),CMAT2(IDIM,IDIM) 53 : ENDSEGMENT 54 : 55 : SEGMENT ,MAXE 56 : REAL*8 TXR(IDIM,IDIM),XLOC(IDIM,IDIM),XGLOB(IDIM,IDIM) 57 : ENDSEGMENT 58 : 59 : C 1 - INITIALISATIONS ET VERIFICATIONS 60 : C ====================================== 61 : MELEME = IPMAIL 62 : c* SEGACT,MELEME 63 : NBNN = NUM(/1) 64 : NBELEM = NUM(/2) 65 : C ===== 66 : MINTE = IPINTE 67 : c* SEGACT,MINTE 68 : NBPGAU = POIGAU(/1) 69 : C ===== 70 : MPTVAL = IVAMAT 71 : c* SEGACT,MPTVAL 72 : C ===== 73 : XMATRI = IPMATR 74 : c* SEGACT,xMATRI*MOD 75 : c* NLIGRP = NBNN = NLIGR 76 : c* NLIGRD = NBNN = NLIGR 77 : C ===== 78 : C Recuperation des fonctions de forme et de leurs derivees au 79 : C centre de gravite de l'element pour le calcul des axes locaux 80 : C d'orthotropie ou d'anisotropie 81 : C ===== 82 : IF (IMATE.EQ.2 .OR.IMATE.EQ.3) THEN 83 : NLG = NUMGEO(NEF) 83 : CALL RESHPT(1,NBNN,NLG,NEF,0,IPINT1,IOK) 84 : c*of IF (IOK.EQ.0) GOTO 999 85 : MINTE1 = IPINT1 86 : SEGACT,MINTE1 87 : NBSH = MINTE1.SHPTOT(/2) 88 : ENDIF 89 : 90 : C ===== 91 : C Initialisation des segments de travail 92 : C ===== 93 : IF (IFOMOD.EQ.1) THEN 94 : NDIM = 3 95 : ELSE 96 : NDIM = IDIM 97 : ENDIF 98 : SEGINI,MMAT1 99 : IF (IMATE.EQ.2 .OR. IMATE.EQ.3) THEN 100 : SEGINI,MAXE 101 : ENDIF 102 : 103 : C 2 - BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IPMAIL 104 : C ============================================================ 105 : DO IEL = 1, NBELEM 106 : * 107 : * MISE A ZERO DU TABLEAU CEL 108 : * 108 : CALL ZERO(CEL,NBNN,NBNN) 109 : * 110 : * COORDONNEES DES NOEUDS DE L'ELEMENT IEL DANS LE REPERE GLOBAL 111 : * 111 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE) 112 : * 113 : C Calcul des axes locaux d'orthotropie ou d'anisotropie 114 : IF (IMATE.EQ.2 .OR. IMATE.EQ.3) THEN 114 : CALL RLOCAL(XE,MINTE1.SHPTOT,NBSH,NBNN,TXR) 115 : IF (nbsh.EQ.-1) THEN 115 : CALL ERREUR(525) 116 : GOTO 9990 117 : ENDIF 118 : ENDIF 119 : * 120 : * BOUCLE SUR LES POINTS DE GAUSS 121 : * 122 : IFOIS = 0 123 : 124 : DO IGAU = 1, NBPGAU 125 : * 126 : * CALCUL DE LA MATRICE GRADIENT DES FONCTIONS DE FORME ET 127 : * DU JACOBIEN,EN UN POINT DE GAUSS 128 : * 128 : CALL TCOND5(IGAU,NBNN,NDIM,XE,SHPTOT,SHP,GRAD,DJAC) 129 : IF (IERR.NE.0) GOTO 9990 130 : IF (DJAC.LT.XZERO) IFOIS=IFOIS+1 131 : * Marino calcul de la matrice des fonctions de forme et confirmation du jacobien 131 : CALL CAPA4(NEF,IGAU,NBNN,XE,SHPTOT,SHP,FORME,DJAC2) 132 : IF ((ABS(DJAC-DJAC2)).GT.1.d-2) THEN 133 : WRITE(*,*) '###ERREUR DANS ADVE: Marino jacob diff ' 134 : INTERR(1) = iElt 134 : CALL ERREUR(259) 135 : GOTO 9990 136 : ENDIF 137 : DJAC = ABS(DJAC) 138 : IF (DJAC.LT.XPETIT) THEN 139 : INTERR(1) = iElt 139 : CALL ERREUR(259) 140 : GOTO 9990 141 : ENDIF 142 : DJAC = DJAC*POIGAU(IGAU) 143 : * 144 : * Recuperation des valeurs des composantes du champ vectoriel 145 : DO i = 1, IDIM 146 : IF (IVAL(i).NE.0) THEN 147 : MELVAL = IVAL(i) 148 : IBMN = MIN(IEL ,VELCHE(/2)) 149 : IGMN = MIN(IGAU,VELCHE(/1)) 150 : V22(i) = DJAC*VELCHE(IGMN,IBMN) 151 : ELSE 152 : V22(i) = XZERO 153 : ENDIF 154 : ENDDO 155 : 156 : C* Comportement isotrope : 157 : IF (IMATE.EQ.1) THEN 158 : DO i = 1, NBNN 159 : r_z = XZERO 160 : DO j = 1, NDIM 161 : r_z = r_z + GRAD(j,i)*V22(j) 162 : ENDDO 163 : V77(i) = r_z 164 : ENDDO 165 : 166 : * CAS SYMETRIQUE 167 : IF (ISYMM.EQ.1) THEN 168 : DO i = 1, NBNN 169 : r_z = V77(i) 170 : DO j = 1, i 171 : CEL(i,j) = CEL(i,j) 172 : & + (r_z*FORME(j) + V77(j)*FORME(i))/2.D0 173 : ENDDO 174 : ENDDO 175 : * NON SYMETRIQUE 176 : ELSE 177 : DO i = 1, NBNN 178 : r_z = V77(i) 179 : DO j = 1, NBNN 180 : CEL(i,j) = CEL(i,j) + (r_z *FORME(j)) 181 : ENDDO 182 : ENDDO 183 : ENDIF 184 : 185 : C* Autres comportements : non disponibles actuellement 186 : ELSE 186 : CALL ERREUR(5) 187 : GOTO 9990 188 : ENDIF 189 : 190 : END DO 191 : 192 : C Erreur si, en un point de Gauss, le jacobien change de signe. 193 : IF (IFOIS.NE.0.AND.IFOIS.NE.NBPGAU) THEN 194 : INTERR(1) = iElt 194 : CALL ERREUR(195) 195 : GOTO 9990 196 : ENDIF 197 : 198 : * REMPLISSAGE DE XMATRI 199 : IF (ISYMM.EQ.1) THEN 199 : CALL REMPMT(CEL,NLIGR,RE(1,1,iel)) 200 : ELSE 200 : CALL REMPMS(CEL,NLIGR,RE(1,1,iel)) 201 : ENDIF 202 : C 203 : ENDDO 204 : * 205 : * DESACTIVATION DES SEGMENTS 206 : * 207 : C 3 - MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS 208 : C ==================================================== 209 : 9990 CONTINUE 210 : SEGSUP,MMAT1 211 : IF (IMATE.EQ.2.OR.IMATE.EQ.3) THEN 212 : SEGDES,MINTE1 213 : SEGSUP,MAXE 214 : ENDIF 215 : 216 : RETURN 217 : END 218 : 219 : 220 :
© Cast3M 2003 - All rights reserved.
Disclaimer