1 : C TCONDU SOURCE CHAT 12/06/07 21:16:06 7389 2 : 3 : C======================================================================= 4 : C= T C O N D U = 5 : C= ----------- = 6 : C= = 7 : C= Fonction : = 8 : C= ---------- = 9 : C= Calcul de la matrice de CONDUCTIVITE THERMIQUE (type RIGIDITE) = 10 : C= = 11 : C= Parametres : (E)=Entree (S)=Sortie = 12 : C= ------------ = 13 : C= IPMODE (E) Segment IMODEL pour un 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 : CONDUCTIVITE (ACTIF) = 17 : C======================================================================= 18 : 19 : SUBROUTINE TCONDU (IPMODE,IPCHEL,ISUPMA, IPRIGI) 20 : 21 : IMPLICIT INTEGER(I-N) 22 : IMPLICIT REAL*8(A-H,O-Z) 23 : 24 : -INC CCOPTIO 25 : -INC CCHAMP 26 : -INC CCGEOME 27 : 28 : -INC SMELEME 29 : -INC SMINTE 30 : -INC SMMODEL 31 : POINTEUR nomid1.NOMID 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 : CHARACTER*8 CMATE 46 : CHARACTER*(LCONMO) CONM 47 : 48 : PARAMETER ( NINF=3 ) 49 : DIMENSION INFOS(NINF) 50 : 51 : C= LEFMAS Liste des numeros d'elements finis MASSIFs a integration 52 : C numerique pour la formulation thermique 53 : C= NEFMAS Longueur de cette liste = 54 : C= LEFCOQ Liste des numeros d'elements finis COQUEs 55 : C= NEFCOQ Longueur de cette liste = 56 : PARAMETER ( NEFMAS = 14 , NEFCOQ=5 ,nefseg=5) 57 : DIMENSION LEFMAS(NEFMAS), LEFCOQ(NEFCOQ),lefseg(nefseg) 58 : C= Petit tableau des "couleurs" pour les relations de conformite 59 : DIMENSION LCOLOR(6) 60 : 61 : C Elements TRI3 TRI6 QUA4 QUA8 CUB8 CU20 PRI6 PR15 TET4 TE10 62 : C MASSIFs PYR5 PY13 T1D2 T1D3 63 : DATA LEFMAS / 4, 6, 8, 10, 14, 15, 16, 17, 23, 24, 64 : & 25, 26, 191, 192/ 65 : C COQUEs COQ2 COQ3 COQ6 COQ4 COQ8 66 : DATA LEFCOQ / 44, 27, 56, 49, 41 / 67 : C element seg2 seg3 tuy2 tuy3 68 : DATA LEFSEG/ 2 , 3 , 46 , 269 , 270/ 69 : DATA LCOLOR / 1, 3, 6, 10, 16, 24 / 70 : 71 : IPINTE = 0 72 : MOMATE = 0 73 : MOTYPE = 0 74 : 75 : C- Matrice de CONDUCTIVITE 76 : MRIGID = IPRIGI 77 : c* SEGACT,MRIGID 78 : NRIGE0 = IRIGEL(/2) 79 : 80 : C- Recuperation du sous-modele et de la zone elementaire associee 81 : IMODEL = IPMODE 82 : c* SEGACT,IMODEL 83 : 84 : NEF = NEFMOD 85 : 86 : C- Recuperation d'informations sur le maillage elementaire 87 : IPT1 = IMAMOD 88 : SEGACT,IPT1 89 : NBNOE1 = IPT1.NUM(/1) 90 : NBELE1 = IPT1.NUM(/2) 91 : * 92 : C- Quelques informations sur le modele (sauf EF de type 22) 93 : IF (NEF.EQ.22) GOTO 2200 94 : 95 : CONM = CONMOD 96 : CMATE = CMATEE 97 : MATE = IMATEE 98 : 99 : IMAS = 0 99 : CALL PLACE2(LEFMAS,NEFMAS,IMAS,NEF) 100 : ICOQ = 0 100 : CALL PLACE2(LEFCOQ,NEFCOQ,ICOQ,NEF) 101 : ise=0 101 : call place2(lefseg,nefseg,ise,nef) 102 : IRET = 1 102 : CALL IDENT(IPT1,CONM,IPCHEL,0, INFOS,IRET) 103 : IF (IRET.EQ.0) GOTO 9990 104 : 105 : C- Recuperation d'informations sur l'element fini 105 : CALL TSHAPE(NEF,'GAUSS',IPINTE) 106 : IF (IERR.NE.0) GOTO 9990 107 : MINTE = IPINTE 108 : SEGACT,MINTE 109 : 110 : C- Recuperation des caracteristiques materielles (obligatoires) 111 : IF (ise.ne.0) THEN 112 : nbrobl = 2 113 : nbrfac = 0 114 : SEGINI,nomid 115 : lesobl(1) = 'K ' 116 : lesobl(2) = 'SECT' 117 : ELSE 118 : nomid1 = LNOMID(6) 119 : SEGINI,nomid=nomid1 120 : IF (ICOQ.NE.0) THEN 121 : nbrobl = lesobl(/2) + 1 122 : nbrfac = 0 123 : SEGADJ,nomid 124 : lesobl(nbrobl) = 'EPAI' 125 : ENDIF 126 : ENDIF 127 : NMATO = lesobl(/2) 128 : NMATF = lesfac(/2) 129 : NMATT = NMATO + NMATF 130 : MOMATE = nomid 131 : c 132 : nbtype = 1 133 : SEGINI,notype 134 : type(1) = 'REAL*8' 135 : MOTYPE = notype 136 : 137 : 2200 CONTINUE 138 : C- Definition du descripteur IDESCR 139 : IDESCR = 0 140 : 141 : C-- Cas particulier des relations de conformite pour la thermique 142 : IF (NEF.EQ.22) THEN 143 : C IF (IPT1.ITYPEL.NE.22) GOTO 9990 144 : IDEBUT = LCOLOR(IPT1.ICOLOR(1)) - 3 145 : * Petite verification sur le nom de la composante mise en relation 146 : nomid = LNOMID(1) 147 : SEGACT,nomid 148 : NEXIST = 0 149 : DO i = 1, LNOMDD 150 : IF (NOMDD(i).EQ.lesobl(1)) NEXIST = i 151 : ENDDO 152 : SEGDES,nomid 153 : IF (NEXIST.EQ.0) THEN 153 : CALL ERREUR(837) 154 : GOTO 9990 155 : ENDIF 156 : * Remplissage du DESCRipteur 157 : NLIGRD = NBNOE1 158 : NLIGRP = NLIGRD 159 : SEGINI,DESCR 160 : LISINC(1) = 'LX ' 161 : LISDUA(1) = 'FLX ' 162 : NOELEP(1) = 1 163 : NOELED(1) = 1 164 : DO i = 2,NLIGRD 165 : LISINC(i) = NOMDD(NEXIST) 166 : LISDUA(i) = NOMDU(NEXIST) 167 : NOELEP(i) = i 168 : NOELED(i) = i 169 : ENDDO 170 : IDESCR = DESCR 171 : 172 : C-- Cas GENERAL 173 : ELSE 173 : CALL TCOND2(ICOQ,NBNOE1,IDESCR) 174 : DESCR = IDESCR 175 : SEGACT,DESCR 176 : NLIGRD = LISDUA(/2) 177 : NLIGRP = LISINC(/2) 178 : ENDIF 179 : 180 : SEGDES,DESCR 181 : LRE = NLIGRD 182 : 183 : C- Partionnement si necessaire de la matrice de conductivite 184 : C- determinant ainsi le nombre d'objets elementaires de MRIGID 185 : LTRK = oooval(1,4) 186 : IF (LTRK.EQ.0) LTRK = oooval(1,1) 187 : C-- Ajout a la taille en mots de la matrice des infos du segment 188 : LSEG = LRE*LRE*NBELE1 + 16 189 : NBLPRT = (LSEG-1)/LTRK + 1 190 : NBLMAX = (NBELE1-1)/NBLPRT + 1 191 : NBLPRT = (NBELE1-1)/NBLMAX + 1 192 : * write(ioimp,*) ' tcondu : nblprt nblmax = ',nblprt,nblmax,nbele1 193 : 194 : C Ajout de la matrice de CONDUCTIVITE a la matrice globale 195 : C ======================================================== 196 : NRIGEL = NRIGE0 + NBLPRT 197 : SEGADJ,MRIGID 198 : 199 : descr = IDESCR 200 : meleme = IPT1 201 : nbnn = NBNOE1 202 : nbelem = NBELE1 203 : nbsous = 0 204 : nbref = 0 205 : 206 : C Boucle sur les PARTITIONS elementaires de la matrice 207 : C ==================================================== 208 : DO irige = 1, NBLPRT 209 : 210 : IF (NBLPRT.GT.1) THEN 211 : C- Partitionnement du maillage support de la matrice elementaire 212 : SEGACT,IPT1 213 : ielem = (irige-1)*NBLMAX 214 : nbelem = MIN(NBLMAX,NBELE1-ielem) 215 : * write(ioimp,*) ' creation segment ',nbnn,nbelem 216 : SEGINI,meleme 217 : itypel = IPT1.itypel 218 : DO ielt = 1, nbelem 219 : jelt = ielt + ielem 220 : DO inoe = 1, nbnn 221 : num(inoe,ielt) = IPT1.NUM(inoe,jelt) 222 : ENDDO 223 : icolor(ielt) = IPT1.ICOLOR(jelt) 224 : ENDDO 225 : C- Recopie du descripteur 226 : des1 = IDESCR 227 : SEGINI,descr=des1 228 : SEGDES,descr 229 : ENDIF 230 : ipmail = meleme 231 : ipdesc = descr 232 : 233 : C- Initialisation de la matrice de rigidite elementaire (xmatri) 234 : NELRIG = nbelem 235 : SEGINI,xmatri 236 : ipmatr = xmatri 237 : 238 : C- Creation des blocages thermiques dus aux relations de compatibilite 239 : IF (NEF.EQ.22) THEN 240 : DO ielt = 1, NELRIG 241 : xmatri.re(2,1,ielt) = -1. 242 : xmatri.re(1,2,ielt) = -1. 243 : DO inoe = 3, NBNOE1 244 : xmatri.re(inoe,1,ielt) = XCOEFF(IDEBUT+inoe) 245 : xmatri.re(1,inoe,ielt) = xmatri.re(inoe,1,ielt) 246 : ENDDO 247 : ENDDO 248 : 249 : C- CAS GENERAL 250 : ELSE 251 : IVAMAT = 0 251 : CALL KOMCHA(IPCHEL,ipmail,CONM,MOMATE,MOTYPE,1,INFOS,3,IVAMAT) 252 : IF (IERR.NE.0) GOTO 9991 253 : IF (ISUPMA.EQ.1) THEN 253 : CALL VALCHE(IVAMAT,NMATT,IPINTE,0) 254 : IF (IERR.NE.0) THEN 255 : ISUPMA = 0 256 : GOTO 9991 257 : ENDIF 258 : ENDIF 259 : C-- Calcul de la matrice elementaire pour la zone iMai et 260 : C-- Remplissage de la matrice globale (ipmatr) 261 : C---> Elements MASSIFs a integration NUMERIQUE 262 : IF (IMAS.NE.0) THEN 262 : CALL TNUMAC(NEF,ipmail,IPINTE,MATE,IVAMAT,NMATT, ipmatr,LRE) 263 : C---> Elements de COQUEs 264 : ELSE IF (ICOQ.NE.0) THEN 265 : GOTO (144,127,156,156,156), ICOQ 266 : GOTO 100 267 : C-----> Element de COQUE AXISYMETRIQUE (COQ2) 268 : 144 CONTINUE 268 : CALL TCOQ2C(NEF,ipmail,IPINTE,MATE,IVAMAT,NMATT, ipmatr,LRE) 269 : GOTO 100 270 : C-----> Element COQ3 271 : 127 CONTINUE 271 : CALL TCOQ3C(NEF,ipmail,IPINTE,MATE,IVAMAT,NMATT, ipmatr,LRE) 272 : GOTO 100 273 : C-----> Element COQ8 ou COQ6 ou COQ4 274 : 156 CONTINUE 274 : CALL TCOQ8C(NEF,ipmail,IPINTE,MATE,IVAMAT,NMATT, ipmatr,LRE) 275 : GOTO 100 276 : 100 CONTINUE 277 : C----> Autres elements 278 : C --> Element BARR (SEG2) ou tuy3 (seg3 ) ou tuy2 (seg2) en conduction 279 : ELSE IF (ise.ne.0) THEN 280 : go to (201,202,201,201,202),ise 281 : go to 200 281 : 201 CALL TSEG2C(NEF,ipmail,IPINTE,MATE,IVAMAT,NMATT, ipmatr,LRE) 282 : go to 200 282 : 202 call tseg3C(nef,ipmail,ipinte,mate,ivamat,nmatt, ipmatr,lre) 283 : go to 200 284 : 200 continue 285 : ELSE 285 : CALL ERREUR(19) 286 : ENDIF 287 : 288 : C- Un peu de menage dans les segments 289 : 9991 CONTINUE 290 : IF (ISUPMA.EQ.1 .OR. NBLPRT.GT.1) THEN 290 : CALL DTMVAL(IVAMAT,3) 291 : ELSE 291 : CALL DTMVAL(IVAMAT,1) 292 : ENDIF 293 : 294 : ENDIF 295 : C- Sortie prematuree en cas d'erreur 296 : IF (IERR.NE.0) GOTO 9990 297 : 298 : xmatri = ipmatr 299 : SEGDES,xmatri 300 : IF (NBLPRT.GT.1) THEN 301 : meleme = ipmail 302 : SEGDES,meleme 303 : ENDIF 304 : 305 : C- Stockage de la matrice 306 : jrige = NRIGE0 + irige 307 : COERIG(jrige) = 1. 308 : IRIGEL(1,jrige) = ipmail 309 : IRIGEL(2,jrige) = 0 310 : IRIGEL(3,jrige) = ipdesc 311 : IRIGEL(4,jrige) = ipmatr 312 : IRIGEL(5,jrige) = NIFOUR 313 : IRIGEL(6,jrige) = 0 314 : IRIGEL(7,jrige) = 0 315 : IRIGEL(8,jrige) = 0 316 : 317 : ENDDO 318 : 319 : C MENAGE : desactivation/destruction de segments 320 : C ============================================== 321 : 9990 CONTINUE 322 : c* SEGDES,MRIGID 323 : c* SEGDES,IMODEL 324 : SEGDES,IPT1 325 : IF (IPINTE.NE.0) THEN 326 : MINTE = IPINTE 327 : SEGDES,MINTE 328 : ENDIF 329 : IF (MOMATE.NE.0) THEN 330 : nomid = MOMATE 331 : SEGSUP,nomid 332 : ENDIF 333 : IF (MOTYPE.NE.0) THEN 334 : notype = MOTYPE 335 : SEGSUP,notype 336 : ENDIF 337 : 338 : RETURN 339 : END 340 : 341 : 342 :
© Cast3M 2003 - All rights reserved.
Disclaimer