C CAPABA SOURCE CB215821 17/01/16 21:15:07 9279 C======================================================================= C= C A P A N U = C= ----------- = C= = C= Fonction : = C= ---------- = C= Calcul de la matrice de CAPACITE CALORIFIQUE d'un element BARRe = C= = C= Parametres : (E)=Entree (S)=Sortie = C= ------------ = C= IMAIL (E) Numero du segment IMODEL dans le segment MMODEL = C= IPCHA1 (E) Pointeur sur un segment MCHEL1 de CARACTERISTIQUES = C= CLAT (E) Chaleur latente du changement de phase = C= TPHA1 (E) Temperature 1 de changement de phase = C= TPHA2 (E) Temperature 2 de changement de phase = C= IPVAL1 (E) CHAMELEM de temperatures au pas N = C= IPVAL2 (E) CHAMELEM de temperatures au pas N + 1 = C= IPRIGI (E/S) Pointeur sur l'objet RIGIDITE (CAPACITE) (ACTIF) = C= = C= Denis ROBERT, le 15 fevrier 1988. = C======================================================================= SUBROUTINE CAPABA (NEF,IPMAIL,IPINTE,IVAMAT,NVAMAT,IVAPHA,NVAPHA, & IPMATR,NLIGR,INFOR) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCREEL -INC CCHAMP -INC SMCOORD -INC SMINTE -INC SMRIGID -INC SMELEME -INC SMCHAML CHARACTER*16 MOFOR INTEGER INFOR SEGMENT MMAT1 REAL*8 CAP(NLIGR,NLIGR),XE(3,NBNN) REAL*8 SHP(6,NBNN),FORME(NBNN) ENDSEGMENT SEGMENT MPTVAL INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU) CHARACTER*16 TYVAL(NCOSOU) ENDSEGMENT SEGMENT SVACOM REAL*8 VACOMP(NVAMAT) ENDSEGMENT SEGINI,SVACOM C* IF (NEF.NE.46) CALL ERREUR(5) IF (IFOMOD.NE.-1 .AND. IFOMOD.NE.2.and.ifomod.ne.0) THEN CALL ERREUR(251) RETURN ENDIF IFIN = IDIM+1 C 1 - INITIALISATIONS ET VERIFICATIONS C ====================================== MELEME = IPMAIL c* SEGACT,MELEME NBNN = NUM(/1) NBELEM = NUM(/2) C ===== MINTE = IPINTE c* SEGACT,MINTE NBPGAU = POIGAU(/1) C ===== c* MPTVAL = IVAMAT c* SEGACT,MPTVAL c* IF (IVAPHA.NE.0) THEN c* MPTVAL = IVAPHA c* SEGACT,MPTVAL c* ENDIF C ===== XMATRI = IPMATR c* SEGACT,XMATRI*MOD c* NLIGRP = NLIGR c* NLIGRD = NLIGR C ===== SEGINI,MMAT1 C 2 - BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IPMAIL C ============================================================ DO iElt = 1, NBELEM C ===== C 2.1 - Mise a zero de la matrice de CAPACITE de l'element iElt C ===== CALL ZERO(CAP,NLIGR,NLIGR) C ===== C 2.2 - Recuperation des coordonnees GLOBALES des noeuds de l'element C ===== CALL DOXE(XCOOR,IDIM,NBNN,NUM,iElt,XE) C ===== C 2.3 - Boucle sur les points de Gauss de l'element iElt C ===== iFois=0 DO iGau = 1, NBPGAU C- Calcul du jacobien, des fonctions de forme et de leurs derivees C- au point de Gauss iGau DO j = 1, NBNN FORME(j) = SHPTOT(1,j,iGau) DO i = 1, IFIN SHP(i,j) = SHPTOT(i,j,iGau) ENDDO ENDDO CALL TCONV4(XE,SHP,IDIM,NBNN,DJAC) IF (IERR.NE.0) GOTO 9990 IF (DJAC.LT.XZero) iFois=iFois+1 DJAC = ABS(DJAC) C- Erreur si le jacobien est nul en ce point de Gauss IF (DJAC.LT.XPetit) THEN INTERR(1) = iElt CALL ERREUR(259) GOTO 9990 ENDIF C- Calcul du terme Rho.Cp.Vol.Se en ce point de Gauss pour la THERMIQUE MPTVAL = IVAMAT DO i = 1, NVAMAT MELVAL = IVAL(i) IGMN = MIN(iGau,VELCHE(/1)) IEMN = MIN(iElt,VELCHE(/2)) VACOMP(i) = VELCHE(IGMN,IEMN) ENDDO VALRHO = VACOMP(1) C CAS THERMIQUE on fait RHO.CP IF (INFOR .EQ. 1) VACOMP(1) = VALRHO * VACOMP(2) C- Erreur si la section d'un element BARRe est nulle SE = VACOMP(NVAMAT) IF (SE.LE.XPetit) THEN CALL ERREUR(517) GOTO 9990 ENDIF CAPA = SE * DJAC * POIGAU(iGau) * VACOMP(1) C- Calcul de la contribution du point de Gauss a la matrice CAPACITE C- elementaire pour cet element fini CALL NTNST(FORME,CAPA,NBNN,1,CAP) C ======= ENDDO C ===== C 2.4 - Erreur si, en un point de Gauss, le jacobien change de signe C ===== IF (iFois.NE.0.AND.iFois.NE.NBPGAU) THEN INTERR(1) = iElt CALL ERREUR(195) GOTO 9990 ENDIF C ===== C 2.5 - Stockage de la matrice de CAPACITE pour cet element fini C (remplissage de XMATRI) C ===== CALL REMPMT(CAP,NLIGR,RE(1,1,iElt)) ENDDO C 3 - MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS C ==================================================== 9990 CONTINUE SEGSUP,MMAT1,SVACOM c* SEGDES,MELEME,MINTE,XMATRI c* MPTVAL = IVAMAT c* SEGDES,MPTVAL c* IF (IVAPHA.NE.0) THEN c* MPTVAL = IVAPHA c* SEGDES,MPTVAL c* ENDIF RETURN END