1 : C CAPAED SOURCE FANDEUR 11/07/19 21:15:28 7042 2 : 3 : C======================================================================= 4 : C= OPERATEUR CAPACITE - MODELE 'DIFFUSION' OU 'ELECTROSTATIQUE' = 5 : C======================================================================= 6 : C= C A P A E D = 7 : C= ----------- = 8 : C= = 9 : C= Fonction : = 10 : C= ---------- = 11 : C= Calcul de la matrice de "CAPACITE" (type RIGIDITE) = 12 : C= = 13 : C= Parametres : (E)=Entree (S)=Sortie = 14 : C= ------------ = 15 : C= IPMODE (E) Segment IMODEL pour un modele elementaire (ACTIF) = 16 : C= IPCHEL (E) Segment MCHELM de CARACTERISTIQUES (?) = 17 : C= ISUPC (E) Support du champ de CARACTERISTIQUES = 18 : C= IPRIGI (E/S) Segment MRIGID : "CAPACITE" (ACTIF) = 19 : C======================================================================= 20 : 21 : SUBROUTINE CAPAED (IPMODE,IPCHEL,ISUPC, IPRIGI) 22 : 23 : 24 : IMPLICIT INTEGER(I-N) 25 : IMPLICIT REAL*8(A-H,O-Z) 26 : 27 : -INC CCOPTIO 28 : -INC CCHAMP 29 : -INC CCGEOME 30 : -INC CCREEL 31 : 32 : -INC SMCHAML 33 : -INC SMCOORD 34 : -INC SMELEME 35 : -INC SMINTE 36 : -INC SMMODEL 37 : -INC SMRIGID 38 : 39 : INTEGER OOOVAL 40 : 41 : SEGMENT NOTYPE 42 : CHARACTER*16 TYPE(NBTYPE) 43 : ENDSEGMENT 44 : 45 : SEGMENT MPTVAL 46 : INTEGER IPOS(NS) ,NSOF(NS) 47 : INTEGER IVAL(NCOSOU) 48 : CHARACTER*16 TYVAL(NCOSOU) 49 : ENDSEGMENT 50 : 51 : SEGMENT INFO 52 : INTEGER INFELL(JG) 53 : ENDSEGMENT 54 : 55 : CHARACTER*8 CMATE 56 : CHARACTER*(LCONMO) CONM 57 : 58 : C= INTTYP definit le support des points d'integration pour CAPAED 59 : C= Cette valeur doit etre coherente avec celle utilisee dans CAPA. 60 : PARAMETER ( INTTYP = 4 ) 61 : 62 : PARAMETER ( NINF=3 ) 63 : INTEGER INFOS(NINF) 64 : 65 : LOGICAL lsupfo,lsupdp 66 : 67 : IPINTE = 0 68 : MOMATE = 0 69 : MOTYPE = 0 70 : MODEPL = 0 71 : MOFORC = 0 72 : lsupdp = .FALSE. 73 : lsupfo = .FALSE. 74 : 75 : C- Matrice de capacite 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 : IF (NEF.EQ.22) GOTO 9991 86 : 87 : C- Recuperation d'informations sur le maillage elementaire 88 : IPT1 = IMAMOD 89 : SEGACT,IPT1 90 : NBNOE1 = IPT1.NUM(/1) 91 : NBELE1 = IPT1.NUM(/2) 92 : 93 : C- Quelques informations sur le modele 94 : CONM = CONMOD 95 : CMATE = CMATEE 96 : MATE = IMATEE 97 : 98 : IRET = 1 98 : CALL IDENT(IPT1,CONM,IPCHEL,0, INFOS,IRET) 99 : IF (IRET.EQ.0) GOTO 9990 100 : 101 : C- Recuperation d'informations sur l'element fini 102 : IF (INFMOD(/1).LT.2+INTTYP) THEN 102 : CALL ELQUOI(NEF,0,INTTYP,IPINF,IMODEL) 103 : IF (IERR.NE.0) GOTO 9990 104 : INFO = IPINF 105 : MFR = INFELL(13) 106 : LRE = INFELL( 9) 107 : MINTE = INFELL(11) 108 : c* NBPGAU = INFELL( 6) 109 : c* NDDL = INFELL(15) 110 : SEGSUP,INFO 111 : ELSE 112 : MFR = INFELE(13) 113 : LRE = INFELE( 9) 114 : MINTE = INFMOD(2+INTTYP) 115 : c* NBPGAU = INFELE( 6) 116 : c* NDDL = INFELE(15) 117 : ENDIF 118 : c* IF (MFR.NE.71 .AND. MFR.NE.73) THEN 118 : c* CALL ERREUR(21) 119 : c* GOTO 9990 120 : c* ENDIF 121 : IPINTE = MINTE 122 : IF (IPINTE.NE.0) SEGACT,MINTE 123 : IPPORE = 0 124 : 125 : C- Recuperation des caracteristiques materielles (obligatoires) 126 : nbrobl = 1 127 : nbrfac = 0 128 : SEGINI,nomid 129 : IF (MFR.EQ.71) THEN 130 : C* IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN 131 : lesobl(1) = 'CJEL ' 132 : ELSE IF (MFR.EQ.73) THEN 133 : C* ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN 134 : lesobl(1) = 'CDIF ' 135 : ENDIF 136 : MOMATE = nomid 137 : NMATT = nbrobl + nbrfac 138 : c 139 : nbtype = 1 140 : SEGINI,notype 141 : type(1) = 'REAL*8' 142 : MOTYPE = notype 143 : 144 : C- Definition du descripteur IDESCR pour le modele elementaire 145 : C-- Recherche des noms d'inconnues primales et duales 146 : IF (LNOMID(1).NE.0) THEN 147 : MODEPL = LNOMID(1) 148 : nomid = MODEPL 149 : SEGACT,nomid 150 : NDEPL = lesobl(/2) 151 : C* ndum = lesfac(/2) 152 : ELSE 153 : lsupdp = .TRUE. 153 : CALL IDDEPL(MFR,IFOUR,MODEPL,NDEPL,ndum) 154 : nomid = MODEPL 155 : SEGACT,nomid 156 : ENDIF 157 : IF (LNOMID(2).NE.0) THEN 158 : MOFORC = LNOMID(2) 159 : nomid = MOFORC 160 : SEGACT,nomid 161 : NFORC = lesobl(/2) 162 : C* ndum =lesfac(/2) 163 : ELSE 164 : lsupfo = .TRUE. 164 : CALL IDFORC(MFR,IFOUR,MOFORC,NFORC,ndum) 165 : nomid = MOFORC 166 : SEGACT,nomid 167 : ENDIF 168 : IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN 168 : CALL ERREUR(5) 169 : GOTO 9990 170 : ENDIF 171 : C-- Initialisation du segment DESCRIPTEUR 172 : NLIGRP = LRE 173 : NLIGRD = LRE 174 : IF (NBNOE1*NDEPL .GT. NLIGRD) THEN 174 : CALL ERREUR(717) 175 : GOTO 9990 176 : ENDIF 177 : SEGINI,DESCR 178 : C-- Remplissage du segment DESCRIPTEUR 179 : IDDL = 1 180 : DO inoe = 1, NBNOE1 181 : DO il = 1, NDEPL 182 : nomid = MODEPL 183 : LISINC(IDDL) = lesobl(il) 184 : NOELEP(IDDL) = inoe 185 : nomid = MOFORC 186 : LISDUA(IDDL) = lesobl(il) 187 : NOELED(IDDL) = inoe 188 : IDDL = IDDL+1 189 : ENDDO 190 : ENDDO 191 : SEGDES,DESCR 192 : IDESCR = DESCR 193 : 194 : C- Partionnement si necessaire de la matrice de capacite 195 : C- determinant ainsi le nombre d'objets elementaires de MRIGID 196 : LTRK = oooval(1,4) 197 : IF (LTRK.EQ.0) LTRK = oooval(1,1) 198 : * Ajout a la taille en mots de la matrice des infos du segment 199 : LSEG = LRE*LRE*NBELE1 + 16 200 : NBLPRT = (LSEG-1)/LTRK + 1 201 : NBLMAX = (NBELE1-1)/NBLPRT + 1 202 : NBLPRT = (NBELE1-1)/NBLMAX + 1 203 : * write(ioimp,*) ' capaed : nblprt nblmax = ',nblprt,nblmax,nbele1 204 : 205 : C Ajout de la matrice de CAPACITE THERMOHYDRIQUE a la matrice globale 206 : C =================================================================== 207 : NRIGEL = NRIGE0 + NBLPRT 208 : SEGADJ,MRIGID 209 : 210 : descr = IDESCR 211 : meleme = IPT1 212 : nbnn = NBNOE1 213 : nbelem = NBELE1 214 : nbsous = 0 215 : nbref = 0 216 : 217 : C Boucle sur les PARTITIONS elementaires de la matrice 218 : C ==================================================== 219 : DO irige = 1, NBLPRT 220 : 221 : IF (NBLPRT.GT.1) THEN 222 : C- Partitionnement du maillage support de la matrice elementaire 223 : SEGACT,IPT1 224 : ielem = (irige-1)*NBLMAX 225 : nbelem = MIN(NBLMAX,NBELE1-ielem) 226 : * write(ioimp,*) ' creation segment ',nbnn,nbelem 227 : SEGINI,meleme 228 : itypel = IPT1.itypel 229 : DO ielt = 1, nbelem 230 : jelt = ielt + ielem 231 : DO inoe = 1, nbnn 232 : num(inoe,ielt) = IPT1.NUM(inoe,jelt) 233 : ENDDO 234 : icolor(ielt) = IPT1.ICOLOR(jelt) 235 : ENDDO 236 : C- Recopie du descripteur 237 : des1 = IDESCR 238 : SEGINI,descr=des1 239 : SEGDES,descr 240 : ENDIF 241 : ipmail = meleme 242 : ipdesc = descr 243 : 244 : C- Initialisation de la matrice de rigidite elementaire (xmatri) 245 : NELRIG = nbelem 246 : SEGINI,xmatri 247 : ipmatr = xmatri 248 : 249 : C- Recuperation du champ des proprietes materielles sur la partition 250 : IVAMAT = 0 250 : CALL KOMCHA(IPCHEL,ipmail,CONM,MOMATE,MOTYPE,1,INFOS,3,IVAMAT) 251 : IF (IERR.NE.0) GOTO 9995 252 : IF (ISUPC1.EQ.1) THEN 252 : CALL VALCHE(IVAMAT,NMATT,IPINTE,IPPORE) 253 : IF (IERR.NE.0) THEN 254 : ISUPC1 = 0 255 : GOTO 9995 256 : ENDIF 257 : ENDIF 258 : 259 : * Calcul de la CAPACITE ELEMENTAIRE 260 : IF (MFR .EQ. 71 .OR. MFR .EQ. 73) THEN 260 : CALL CAPDIF(NEF,ipmail,ipinte,IVAMAT,NMATT, ipmatr) 261 : ELSE 261 : CALL ERREUR(21) 262 : ENDIF 263 : 264 : C- Un peu de menage dans les segments 265 : 9995 CONTINUE 266 : IF (ISUPC.EQ.1 .OR. NBLPRT.GT.1) THEN 266 : CALL DTMVAL(IVAMAT,3) 267 : ELSE 267 : CALL DTMVAL(IVAMAT,1) 268 : ENDIF 269 : C- Sortie prematuree en cas d'erreur 270 : IF (IERR.NE.0) GOTO 9990 271 : 272 : xmatri = ipmatr 273 : SEGDES,xmatri 274 : IF (NBLPRT.GT.1) THEN 275 : meleme = ipmail 276 : SEGDES,meleme 277 : ENDIF 278 : 279 : C- Stockage de la matrice de capacite 280 : jrige = NRIGE0 + irige 281 : COERIG(jrige) = 1. 282 : IRIGEL(1,jrige) = ipmail 283 : IRIGEL(2,jrige) = 0 284 : IRIGEL(3,jrige) = ipdesc 285 : IRIGEL(4,jrige) = ipmatr 286 : IRIGEL(5,jrige) = NIFOUR 287 : IRIGEL(6,jrige) = 0 288 : IRIGEL(7,jrige) = 0 289 : IRIGEL(8,jrige) = 0 290 : 291 : ENDDO 292 : 293 : IPRIGI = MRIGID 294 : 295 : C FIN DU TRAITEMENT : desactivation/destruction de segments 296 : C ========================================================= 297 : 9990 CONTINUE 298 : SEGDES,IPT1 299 : IF (IPINTE.NE.0) THEN 300 : MINTE = IPINTE 301 : SEGDES,MINTE 302 : ENDIF 303 : IF (MOMATE.NE.0) THEN 304 : nomid = MOMATE 305 : SEGSUP,nomid 306 : ENDIF 307 : IF (MOTYPE.NE.0) THEN 308 : notype = MOTYPE 309 : SEGSUP,notype 310 : ENDIF 311 : IF (MODEPL.NE.0) THEN 312 : nomid = MODEPL 313 : SEGDES,nomid 314 : IF (lsupdp) SEGSUP,nomid 315 : ENDIF 316 : IF (MOFORC.NE.0) THEN 317 : nomid = MOFORC 318 : SEGDES,nomid 319 : IF (lsupfo) SEGSUP,nomid 320 : ENDIF 321 : 9991 CONTINUE 322 : c* SEGDES,IMODEL 323 : c* SEGDES,MRIGID 324 : 325 : RETURN 326 : END 327 : 328 :
© Cast3M 2003 - All rights reserved.
Disclaimer