1 : C CAPA SOURCE CHAT 12/06/07 21:15:05 7389 2 : 3 : C======================================================================= 4 : C= C A P A = 5 : C= ------- = 6 : C= = 7 : C= OPERATEUR DE CALCUL DE LA MATRICE DE CAPACITE (CALORIFIQUE) : = 8 : C= ------------------------------------------------------------- = 9 : C= CAP1 = 'CAPACITE' MODL1 CARA1 ( TAB1 ) ; = 10 : C= = 11 : C= ARGUMENTS : = 12 : C= ----------- = 13 : C= MODL1 (MMODEL) Modele (global) associe a la structure = 14 : C= CARA1 (MCHAML) Caracteristiques thermiques du(des) materiau(x)= 15 : C= Sous-type 'CARACTERISTIQUES' = 16 : C= TAB1 (TABLE) Table contenant les grandeurs liees a un chan- = 17 : C= gement de phase eventuel (facultatif) = 18 : C= Sous-type 'THERMIQUE' = 19 : C= = 20 : C= RESULTAT : = 21 : C= ---------- = 22 : C= CAP1 (RIGIDITE) Matrice de capacite calorifique = 23 : C= = 24 : C= Denis ROBERT, le 15 fevrier 1988. = 25 : C= Zakaria HABIBI, modification le 30 juin 2008(partie thermohydrique)= 26 : C======================================================================= 27 : 28 : SUBROUTINE CAPA 29 : 30 : IMPLICIT INTEGER(I-N) 31 : IMPLICIT REAL*8 (A-H,O-Z) 32 : 33 : -INC CCOPTIO 34 : 35 : -INC SMCHAML 36 : -INC SMMODEL 37 : -INC SMRIGID 38 : 39 : CHARACTER*9 MO1 40 : LOGICAL L0,L1 41 : 42 : C 1 - LECTURE DES ARGUMENTS DE L'OPERATEUR 43 : C ========================================== 44 : C 1.1 - Lecture OBLIGATOIRE du modele (IPMODE) 45 : C ===== 46 : MOTERR(1:8)=' MODELE ' 46 : CALL MESLIR(-137) 46 : CALL LIROBJ('MMODEL',IPMODE,1,IRet) 47 : IF (IERR.NE.0) RETURN 48 : C ===== 49 : C 1.2 - Lecture OBLIGATOIRE du champ de caracteristiques (IPCHEL) 50 : C ===== 50 : CALL MESLIR(-135) 50 : CALL LIROBJ('MCHAML',IPCHEL,1,IRet) 51 : IF (IERR.NE.0) RETURN 52 : C ===== 53 : C 1.3 - Lecture FACULTATIVE de la table des donnees liees a un 54 : C changement de phase (ITABL) 55 : C ===== 56 : ITABL=0 56 : CALL MESLIR(-136) 56 : CALL LIROBJ('TABLE',ITABL,0,IRet) 57 : IF (IERR.NE.0) RETURN 58 : 59 : C 2 - VERIFICATIONS DES DONNEES DE L'OPERATEUR 60 : C ============================================== 61 : C 2.1 - Verification du sous-type du MCHAML de caracteristiques 62 : C ===== 63 : MCHELM=IPCHEL 64 : SEGACT,MCHELM 65 : IF (TITCHE(1:8).NE.'CARACTER') THEN 66 : SEGDES,MCHELM 67 : MOTERR='CARACTERISTIQUES' 67 : CALL ERREUR(291) 68 : RETURN 69 : ENDIF 70 : SEGDES,MCHELM 71 : C ===== 72 : C 2.2 - Verification du sous-type de la TABLE 73 : C (l'indice 'SOUSTYPE' doit valoir 'THERMIQUE') 74 : C ===== 75 : IF (ITABL.NE.0) THEN 75 : CALL ACCTAB(ITABL,'MOT',I0,X0,'SOUSTYPE',L0,IP0, 76 : & 'MOT',I1,X1,MO1,L1,IP1) 77 : IF (IERR.NE.0) RETURN 78 : IF (MO1.NE.'THERMIQUE') THEN 78 : CALL ERREUR(314) 79 : RETURN 80 : ENDIF 81 : ENDIF 82 : 83 : C 3 - CONSTRUCTION DE LA MATRICE DE CAPACITE 84 : C ============================================ 85 : C 3.1 - Initialisation de la matrice : 86 : C ===== 87 : NRIGEL = 0 88 : SEGINI,MRIGID 89 : MTYMAT = 'RIGIDITE' 90 : ICHOLE = 0 91 : IMGEO1 = 0 92 : IMGEO2 = 0 93 : C* IFORIG = IFOMOD 94 : IFORIG = IFOUR 95 : ISUPEQ = 0 96 : IPRIGI = MRIGID 97 : C ===== 98 : C 3.2 - Remplissage de la matrice pour chaque modele concerne 99 : C ===== 100 : MMODEL=IPMODE 101 : SEGACT,MMODEL 102 : NB1 = KMODEL(/1) 103 : IF (NB1.GT.1) THEN 104 : N1 = 1 105 : SEGINI,MMODE1 106 : IPMOD1 = MMODE1 107 : ELSE 108 : IPMOD1 = IPMODE 109 : ENDIF 110 : DO IA = 1, NB1 111 : IMODEL = KMODEL(IA) 112 : SEGACT,IMODEL 113 : ITHER = 0 114 : ITHHY = 0 115 : IDIFF = 0 116 : IELEC = 0 117 : IF (FORMOD(1).EQ.'THERMIQUE') THEN 118 : do iyu=1,matmod(/2) 119 : if( matmod(iyu).eq.'CONVECTION' ) go to 1 120 : if( matmod(iyu).eq.'RAYONNEMENT') go to 1 121 : enddo 122 : ITHER = 1 123 : ISUPC = 6 124 : ELSE IF (FORMOD(1).EQ.'THERMOHYDRIQUE') THEN 125 : ITHHY = 1 126 : ISUPC = 6 127 : ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN 128 : IDIFF = 1 129 : ISUPC = 4 130 : C* ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN 131 : C* IELEC = 1 132 : C* ISUPC = 4 133 : ELSE 134 : MOTERR(1:8) = FORMOD(1) 134 : CALL ERREUR(193) 135 : SEGDES,IMODEL 136 : GOTO 9999 137 : ENDIF 138 : IF (NB1.GT.1) THEN 139 : SEGACT,MMODE1*MOD 140 : MMODE1.KMODEL(1) = IMODEL 141 : ENDIF 141 : CALL REDUAF(IPCHEL,IPMOD1,IPCHE1,0,IRET,KERRE) 142 : IF (IRET.NE.1) THEN 142 : CALL ERREUR(KERRE) 143 : GOTO 9999 144 : ENDIF 145 : C Verification du lieu support du MCHAML de caracteristiques 146 : ISUPC1 = 0 146 : CALL QUESUP(IPMOD1,IPCHE1,ISUPC,0,ISUPC1,IRET) 147 : IF (ISUPC1.GT.1) GOTO 9999 148 : C Reactivation du modele elementaire (desactive dans REDUAF) 149 : SEGACT,IMODEL 150 : IF (ITHHY.NE.0) THEN 150 : CALL THCAPA1(IMODEL,IPCHE1,ISUPC1, IPRIGI) 151 : ELSE IF (IDIFF.NE.0.OR.IELEC.NE.0) THEN 151 : CALL CAPAED(IMODEL,IPCHE1,ISUPC1, IPRIGI) 152 : ELSE 152 : CALL CAPA1(IMODEL,IPCHE1,ISUPC1, ITABL,IPRIGI) 153 : ENDIF 154 : 1 CONTINUE 155 : SEGDES,IMODEL 156 : IF (IERR.NE.0) GOTO 9999 157 : ENDDO 158 : 159 : NRIGEL = IRIGEL(/2) 160 : IF (NRIGEL.EQ.0) THEN 160 : CALL ERREUR(19) 161 : ENDIF 162 : 9999 CONTINUE 163 : IF (IERR.NE.0) THEN 164 : SEGSUP,MRIGID 165 : ELSE 166 : SEGDES,MRIGID 166 : CALL ECROBJ('RIGIDITE',IPRIGI) 167 : ENDIF 168 : 169 : SEGDES,MMODEL 170 : IF (NB1.GT.1) SEGSUP,MMODE1 171 : C 172 : RETURN 173 : END 174 : 175 : 176 :
© Cast3M 2003 - All rights reserved.
Disclaimer