1 : C CAPABA SOURCE CHAT 12/06/07 21:15:05 7389 2 : C CAPANU SOURCE CHAT 11/03/16 21:16:31 6902 3 : 4 : C======================================================================= 5 : C= C A P A N U = 6 : C= ----------- = 7 : C= = 8 : C= Fonction : = 9 : C= ---------- = 10 : C= Calcul de la matrice de CAPACITE CALORIFIQUE d'un element BARRe = 11 : C= = 12 : C= Parametres : (E)=Entree (S)=Sortie = 13 : C= ------------ = 14 : C= IMAIL (E) Numero du segment IMODEL dans le segment MMODEL = 15 : C= IPCHA1 (E) Pointeur sur un segment MCHEL1 de CARACTERISTIQUES = 16 : C= CLAT (E) Chaleur latente du changement de phase = 17 : C= TPHA1 (E) Temperature 1 de changement de phase = 18 : C= TPHA2 (E) Temperature 2 de changement de phase = 19 : C= IPVAL1 (E) CHAMELEM de temperatures au pas N = 20 : C= IPVAL2 (E) CHAMELEM de temperatures au pas N + 1 = 21 : C= IPRIGI (E/S) Pointeur sur l'objet RIGIDITE (CAPACITE) (ACTIF) = 22 : C= = 23 : C= Denis ROBERT, le 15 fevrier 1988. = 24 : C======================================================================= 25 : 26 : SUBROUTINE CAPABA (NEF,IPMAIL,IPINTE,IVAMAT,NVAMAT,IVAPHA,NVAPHA, 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 SMCOORD 37 : -INC SMINTE 38 : -INC SMRIGID 39 : -INC SMELEME 40 : -INC SMCHAML 41 : 42 : SEGMENT MMAT1 43 : REAL*8 CAP(NLIGR,NLIGR),XE(3,NBNN) 44 : REAL*8 SHP(6,NBNN),FORME(NBNN) 45 : ENDSEGMENT 46 : 47 : SEGMENT MPTVAL 48 : INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU) 49 : CHARACTER*16 TYVAL(NCOSOU) 50 : ENDSEGMENT 51 : 52 : REAL*8 VACOMP(3) 53 : 53 : C* IF (NEF.NE.46) CALL ERREUR(5) 54 : IF (IFOMOD.NE.-1 .AND. IFOMOD.NE.2.and.ifomod.ne.0) THEN 54 : CALL ERREUR(251) 55 : RETURN 56 : ENDIF 57 : IFIN = IDIM+1 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 : c* MPTVAL = IVAMAT 71 : c* SEGACT,MPTVAL 72 : c* IF (IVAPHA.NE.0) THEN 73 : c* MPTVAL = IVAPHA 74 : c* SEGACT,MPTVAL 75 : c* ENDIF 76 : C ===== 77 : XMATRI = IPMATR 78 : c* SEGACT,XMATRI*MOD 79 : c* NLIGRP = NLIGR 80 : c* NLIGRD = NLIGR 81 : C ===== 82 : SEGINI,MMAT1 83 : 84 : C 2 - BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IPMAIL 85 : C ============================================================ 86 : DO iElt = 1, NBELEM 87 : C ===== 88 : C 2.1 - Mise a zero de la matrice de CAPACITE de l'element iElt 89 : C ===== 89 : CALL ZERO(CAP,NLIGR,NLIGR) 90 : C ===== 91 : C 2.2 - Recuperation des coordonnees GLOBALES des noeuds de l'element 92 : C ===== 92 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,iElt,XE) 93 : C ===== 94 : C 2.3 - Boucle sur les points de Gauss de l'element iElt 95 : C ===== 96 : iFois=0 97 : DO iGau = 1, NBPGAU 98 : C- Calcul du jacobien, des fonctions de forme et de leurs derivees 99 : C- au point de Gauss iGau 100 : DO j = 1, NBNN 101 : FORME(j) = SHPTOT(1,j,iGau) 102 : DO i = 1, IFIN 103 : SHP(i,j) = SHPTOT(i,j,iGau) 104 : ENDDO 105 : ENDDO 105 : CALL TCONV4(XE,SHP,IDIM,NBNN,DJAC) 106 : IF (IERR.NE.0) GOTO 9990 107 : IF (DJAC.LT.XZero) iFois=iFois+1 108 : DJAC = ABS(DJAC) 109 : C- Erreur si le jacobien est nul en ce point de Gauss 110 : IF (DJAC.LT.XPetit) THEN 111 : INTERR(1) = iElt 111 : CALL ERREUR(259) 112 : GOTO 9990 113 : ENDIF 114 : C- Calcul du terme Rho.Cp.Vol.Se en ce point de Gauss avec prise en 115 : C- compte d'un eventuel changement de phase 115 : CALL CAPA5(iGau,iElt,IVAMAT,NVAMAT,IVAPHA,NVAPHA, VACOMP) 116 : C- Erreur si la section d'un element BARRe est nulle 117 : SE = VACOMP(3) 118 : IF (SE.LE.XPetit) THEN 118 : CALL ERREUR(517) 119 : GOTO 9990 120 : ENDIF 121 : CAPA = SE * DJAC * POIGAU(iGau) * VACOMP(1) 122 : C- Calcul de la contribution du point de Gauss a la matrice CAPACITE 123 : C- elementaire pour cet element fini 123 : CALL NTNST(FORME,CAPA,NBNN,1,CAP) 124 : 125 : C ======= 126 : ENDDO 127 : C ===== 128 : C 2.4 - Erreur si, en un point de Gauss, le jacobien change de signe 129 : C ===== 130 : IF (iFois.NE.0.AND.iFois.NE.NBPGAU) THEN 131 : INTERR(1) = iElt 131 : CALL ERREUR(195) 132 : GOTO 9990 133 : ENDIF 134 : C ===== 135 : C 2.5 - Stockage de la matrice de CAPACITE pour cet element fini 136 : C (remplissage de XMATRI) 137 : C ===== 137 : CALL REMPMT(CAP,NLIGR,RE(1,1,iElt)) 138 : ENDDO 139 : 140 : C 3 - MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS 141 : C ==================================================== 142 : 9990 CONTINUE 143 : SEGSUP,MMAT1 144 : c* SEGDES,MELEME,MINTE,XMATRI 145 : c* MPTVAL = IVAMAT 146 : c* SEGDES,MPTVAL 147 : c* IF (IVAPHA.NE.0) THEN 148 : c* MPTVAL = IVAPHA 149 : c* SEGDES,MPTVAL 150 : c* ENDIF 151 : 152 : RETURN 153 : END 154 : 155 : 156 :
© Cast3M 2003 - All rights reserved.
Disclaimer