1 : C TCONVE SOURCE FANDEUR 11/07/19 21:17:32 7042 2 : 3 : C======================================================================= 4 : C= T C O N V E = 5 : C= ----------- = 6 : C= = 7 : C= Fonction : = 8 : C= ---------- = 9 : C= Calcul de la matrice de CONDUCTIVITE de sous-type CONVECTION = 10 : C= = 11 : C= Parametres : (E)=Entree (S)=Sortie = 12 : C= ------------ = 13 : C= IPMODE (E) Segment IMODEL (modele elementaire) (ACTIF) = 14 : C= IPCHEL (E) Segment MCHELM de CARACTERISTIQUES (?) = 15 : C= ISUPMA (E) Support du champ de caracteristiques materiau = 16 : C= IPRIGI (E/S) Segment MRIGID CONVECTION (ACTIF) = 17 : C======================================================================= 18 : 19 : SUBROUTINE TCONVE(IPMODE,IPCHEL,ISUPMA, IPRIGI) 20 : 21 : IMPLICIT INTEGER(I-N) 22 : IMPLICIT REAL*8 (A-H,O-Z) 23 : 24 : -INC CCOPTIO 25 : -INC CCREEL 26 : 27 : -INC SMCHAML 28 : -INC SMCOORD 29 : -INC SMELEME 30 : -INC SMINTE 31 : -INC SMMODEL 32 : -INC SMRIGID 33 : 34 : INTEGER OOOVAL 35 : 36 : SEGMENT NOTYPE 37 : CHARACTER*16 TYPE(NBTYPE) 38 : ENDSEGMENT 39 : 40 : SEGMENT MPTVAL 41 : INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU) 42 : CHARACTER*16 TYVAL(NCOSOU) 43 : ENDSEGMENT 44 : 45 : SEGMENT MMAT1 46 : REAL*8 CEL(LRE,LRE),XE(3,NNNN) 47 : REAL*8 SHP(6,NNNN),FORME(NNNN) 48 : ENDSEGMENT 49 : 50 : PARAMETER ( NINF=3 ) 51 : DIMENSION INFOS(NINF) 52 : 53 : CHARACTER*(8) CMATE 54 : CHARACTER*(LCONMO) CONM 55 : CHARACTER*10 PEAU 56 : 57 : C= LEFCON Liste des numeros d'elements finis supportant la CONVECTION 58 : C= NEFCON Longueur de cette liste = 59 : C= LEFCOQ Liste des numeros d'elements finis COQUEs 60 : C= NEFCOQ Longueur de cette liste = 61 : PARAMETER ( NEFCON = 13 , NEFCOQ=5 ) 62 : DIMENSION LEFCON(NEFCON), LEFCOQ(NEFCOQ) 63 : C ============ 64 : C Elements SEG2 SEG3 TRI3 TRI6 QUA4 QUA8 RAC2 RAC3 LIA3 LIA6 65 : C CONVECTION LIA4 LIA8 POI1 66 : DATA LEFCON / 2, 3, 4, 6, 8, 10, 12, 13, 18, 19, 67 : & 20, 21, 1 / 68 : C ============ 69 : C Elements COQUEs COQ2 COQ3 COQ6 COQ4 COQ8 70 : DATA LEFCOQ / 44, 27, 56, 49, 41 / 71 : 72 : C 1 - INITIALISATIONS ET VERIFICATIONS 73 : C ====================================== 74 : C 1.0 - Matrice de CONDUCTIVITE 75 : C === 76 : MRIGID = IPRIGI 77 : c* SEGACT,MRIGID 78 : NRIGE0 = IRIGEL(/2) 79 : 80 : C 1.1 - Recuperation du sous-modele et de la zone elementaire associee 81 : C === 82 : IMODEL=IPMODE 83 : c* SEGACT,IMODEL 84 : c 85 : CMATE = CMATEE 86 : MATE = IMATEE 87 : PEAU = MATMOD(1) 88 : c 89 : CONM = CONMOD 90 : NEF = NEFMOD 91 : 92 : c Element fini de type COQUE ? 93 : ICOQ = 0 93 : CALL PLACE2(LEFCOQ,NEFCOQ,ICOQ,NEF) 94 : 95 : NLG = NUMGEO(NEF) 96 : IF ((IDIM.EQ.1).AND.(NEF.EQ.2)) NLG = 1 97 : C ERREUR : Element fini non implemente 97 : CALL PLACE2(LEFCON,NEFCON,ICON,NLG) 98 : IF (ICON.EQ.0) THEN 98 : CALL ERREUR(19) 99 : RETURN 100 : ENDIF 101 : c 102 : IPT1 = IMAMOD 103 : SEGACT,IPT1 104 : NBNOE1 = IPT1.NUM(/1) 105 : NBELE1 = IPT1.NUM(/2) 106 : 107 : IPINTE = 0 108 : IVAMAT = 0 109 : MOMATE = 0 110 : MOTYPE = 0 111 : 112 : C 1.2 - Remplissage du tableau INFOS 113 : C === 114 : IRET = 1 114 : CALL IDENT(IPT1,CONM,IPCHEL,0, INFOS,IRET) 115 : IF (IRET.EQ.0) GOTO 9990 116 : 117 : C 1.3 - Recuperation d'informations sur l'element fini 118 : C === 118 : CALL TSHAPE(NLG,'GAUSS',IPINTE) 119 : IF (IERR.NE.0) GOTO 9990 120 : MINTE = IPINTE 121 : SEGACT,MINTE 122 : NBPGAU = POIGAU(/1) 123 : 124 : C 1.4 - Recuperation des caracteristiques materielles (obligatoires) 125 : C === 126 : nbrobl = 1 127 : nbrfac = 0 128 : SEGINI,nomid 129 : lesobl(1) = 'H ' 130 : NMATO = nbrobl 131 : NMATF = nbrfac 132 : NMATT = NMATO + NMATF 133 : MOMATE = nomid 134 : C 135 : NBTYPE = 1 136 : SEGINI,notype 137 : TYPE(1) = 'REAL*8' 138 : MOTYPE = notype 139 : 140 : C 1.5 - Definition du descripteur IDESCR 141 : C === 142 : IDESCR = 0 142 : CALL TCONV2(ICOQ,PEAU,NBNOE1,IDESCR) 143 : descr = IDESCR 144 : SEGACT,descr 145 : NLIGRP = LISINC(/2) 146 : NLIGRD = LISDUA(/2) 147 : SEGDES,descr 148 : 149 : C 1.6 - Comme on traite la CONVECTION et les echanges FACE A FACE, on 150 : C introduit le nombre de NOEUDS pour les elements FACE A FACE. 151 : C === 152 : NBN2 = NBNOE1 153 : IF ((NEF.EQ.12) .OR. (NEF.EQ.13) .OR. (NEF.EQ.18) .OR. 154 : & (NEF.EQ.19) .OR. (NEF.EQ.20) .OR. (NEF.EQ.21) .OR. 155 : & ((IDIM.EQ.1).AND.(NEF.EQ.2)) ) 156 : & NBN2 = NBNOE1 / 2 157 : C equivalent a ? IF (ICON.GE.7) NBN2 = NBNOE1 / 2 158 : 159 : C 1.7 - Partionnement si necessaire de la matrice de conductivite 160 : C determinant ainsi le nombre d'objets elementaires de MRIGID 161 : C === 162 : LTRK = oooval(1,4) 163 : IF (LTRK.EQ.0) LTRK = oooval(1,1) 164 : * Ajout a la taille en mots de la matrice des infos du segment 165 : LSEG = LRE*LRE*NBELE1 + 16 166 : NBLPRT = (LSEG-1)/LTRK + 1 167 : NBLMAX = (NBELE1-1)/NBLPRT + 1 168 : NBLPRT = (NBELE1-1)/NBLMAX + 1 169 : * write(ioimp,*) ' tconve : nblprt nblmax = ',nblprt,nblmax,nbele1 170 : 171 : C 2 - Ajout de la matrice de CONVECTION a la matrice globale 172 : C ========================================================== 173 : NRIGEL = NRIGE0 + NBLPRT 174 : SEGADJ,MRIGID 175 : 176 : descr = IDESCR 177 : meleme = IPT1 178 : nbnn = NBNOE1 179 : nbelem = NBELE1 180 : nbsous = 0 181 : nbref = 0 182 : 183 : C Petit segment de travail : 184 : LRE = NLIGRD 185 : NNNN = NBNOE1 186 : SEGINI,MMAT1 187 : 188 : C 3 - Boucle sur les PARTITIONS elementaires de la matrice 189 : C========================================================= 190 : DO irige = 1, NBLPRT 191 : 192 : IF (NBLPRT.GT.1) THEN 193 : C Partitionnement du maillage support de la matrice elementaire 194 : SEGACT,IPT1 195 : ielem = (irige-1)*NBLMAX 196 : nbelem = MIN(NBLMAX,NBELE1-ielem) 197 : * write(ioimp,*) ' creation segment ',nbnn,nbelem 198 : SEGINI,meleme 199 : itypel = IPT1.itypel 200 : DO ielt = 1, nbelem 201 : jelt = ielt + ielem 202 : DO inoe = 1, nbnn 203 : num(inoe,ielt) = IPT1.NUM(inoe,jelt) 204 : ENDDO 205 : icolor(ielt) = IPT1.ICOLOR(jelt) 206 : ENDDO 207 : C Recopie du descripteur 208 : des1 = IDESCR 209 : SEGINI,descr=des1 210 : SEGDES,descr 211 : ENDIF 212 : ipmail = meleme 213 : ipdesc = descr 214 : 215 : C Initialisation de la matrice de rigidite elementaire (xmatri) 216 : NELRIG = nbelem 217 : SEGINI,xmatri 218 : ipmatr = xmatri 219 : 219 : CALL KOMCHA(IPCHEL,ipmail,CONM,MOMATE,MOTYPE,1,INFOS,3,IVAMAT) 220 : IF (IERR.NE.0) GOTO 9991 221 : IF (ISUPMA.EQ.1) THEN 221 : CALL VALCHE(IVAMAT,NMATT,IPINTE,0) 222 : IF (IERR.NE.0) THEN 223 : ISUPMA = 0 224 : GOTO 9991 225 : ENDIF 226 : ENDIF 227 : C Preparation du champ de caracteristiques 'H' 228 : MPTVAL = IVAMAT 229 : MELVAL = IVAL(1) 230 : IVEL1 = VELCHE(/1) 231 : IVEL2 = VELCHE(/2) 232 : 233 : C 3.2 - Boucle sur les elements du maillage elementaire (ipmail) 234 : C ============================================================== 235 : DO iel = 1, nbelem 236 : 237 : iemn = MIN(iel,IVEL2) 238 : C- Mise a zero de la matrice de CONVECTION de l'element iel 238 : CALL ZERO(CEL,LRE,LRE) 239 : C- Recuperation des coordonnees GLOABLES des noeuds de l'element 239 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,iel,XE) 240 : 241 : C- BOUCLE sur les points de Gauss de l'element iel 242 : iFois = 0 243 : DO igau = 1, NBPGAU 244 : 245 : C-- Calcul du jacobien, des fonctions de forme et de leurs 246 : C-- derivees au point de Gauss igau 246 : CALL TCONV3(NLG,igau,NBNN,NBN2,XE,SHPTOT,SHP,FORME,DJAC) 247 : IF (IERR.NE.0) GOTO 9991 248 : IF (DJAC.LT.XZERO) iFois=iFois+1 249 : DJAC = ABS(DJAC) 250 : C-- Erreur si le jacobien est nul en ce point de Gauss 251 : IF (DJAC.LT.XPETIT) THEN 252 : INTERR(1) = iel 252 : CALL ERREUR(259) 253 : GOTO 9991 254 : ENDIF 255 : C-- Calcul du terme .Vol en ce point de Gauss 256 : igmn = MIN(igau,IVEL1) 257 : COEF = DJAC * POIGAU(igau) * VELCHE(igmn,iemn) 258 : C-- Calcul de la contribution du point de Gauss a la matrice de 259 : C-- CONVECTION elementaire pour cet element fini 259 : CALL NTNST(FORME,COEF,LRE,1,CEL) 260 : ENDDO 261 : C- FIN DE LA BOUCLE sur les points d'integration de l'element iel 262 : 263 : C- Erreur si, en un point de Gauss, le jacobien change de signe. 264 : IF (iFois.NE.0.AND.iFois.NE.NBPGAU) THEN 265 : INTERR(1) = iel 265 : CALL ERREUR(195) 266 : GOTO 9991 267 : ENDIF 268 : C- Stockage de la matrice de CONVECTION pour cet element fini : 269 : C- remplissage de xmatri 269 : CALL REMPMT(CEL,LRE,xmatri.re(1,1,iel)) 270 : 271 : ENDDO 272 : C= FIN DE LA BOUCLE sur les elements 273 : 274 : 9991 CONTINUE 275 : IF (ISUPMA.EQ.1 .OR. NBLPRT.NE.1) THEN 275 : CALL DTMVAL(IVAMAT,3) 276 : ELSE 276 : CALL DTMVAL(IVAMAT,1) 277 : ENDIF 278 : IF (IERR.NE.0) GOTO 9990 279 : 280 : xmatri = ipmatr 281 : SEGDES,xmatri 282 : IF (NBLPRT.GT.1) THEN 283 : meleme = ipmail 284 : SEGDES,meleme 285 : ENDIF 286 : 287 : jrige = NRIGE0 + irige 288 : COERIG(jrige) = 1. 289 : IRIGEL(1,jrige) = ipmail 290 : IRIGEL(2,jrige) = 0 291 : IRIGEL(3,jrige) = ipdesc 292 : IRIGEL(4,jrige) = ipmatr 293 : IRIGEL(5,jrige) = NIFOUR 294 : IRIGEL(6,jrige) = 0 295 : IRIGEL(7,jrige) = 0 296 : IRIGEL(8,jrige) = 0 297 : 298 : ENDDO 299 : 300 : IPRIGI = MRIGID 301 : 302 : C MENAGE : desactivation/destruction de segments 303 : C ============================================== 304 : 9990 CONTINUE 305 : IF (IPINTE.NE.0) THEN 306 : MINTE = IPINTE 307 : SEGDES,MINTE 308 : ENDIF 309 : IF (MOMATE.NE.0) THEN 310 : nomid = MOMATE 311 : SEGSUP,nomid 312 : ENDIF 313 : IF (MOTYPE.NE.0) THEN 314 : notype = MOTYPE 315 : SEGSUP,notype 316 : ENDIF 317 : SEGDES,IPT1 318 : c* SEGDES,MRIGID 319 : c* SEGDES,IMODEL 320 : 321 : RETURN 322 : END 323 : 324 :
© Cast3M 2003 - All rights reserved.
Disclaimer