1 : C CHABAT SOURCE CHAT 11/03/16 21:16:43 6902 2 : 3 : C======================================================================= 4 : C= C H A B A T = 5 : C= ----------- = 6 : C= = 7 : C= Fonction : = 8 : C= ---------- = 9 : C= Calcul des flux equivalents a des sources volumiques dans le cas = 10 : C des elements BARRE (en THERMIQUE). = 11 : C= = 12 : C= Parametres : (E)=Entree (S)=Sortie = 13 : C= ------------ = 14 : C= IPMODL (E) Pointeur sur le segment MMODEL de la structure = 15 : C= IPCHSO (E) Pointeur sur le MCHAML aux noeuds de sources = 16 : C= IPCHEB (E) Pointeur sur le segment MCHAML de CARACTERISTIQUES = 17 : C= utiles pour les elements BARREs = 18 : C= NOMDUA (E) Nom de la composante du champ de flux equivalents = 19 : C= IPCHAL (S) Pointeur sur le champ des flux equivalents = 20 : C======================================================================= 21 : 22 : SUBROUTINE CHABAT (IPMODL,IPCHSO,IPCHEB,NOMDUA, IPCHAL) 23 : 24 : IMPLICIT INTEGER(I-N) 25 : IMPLICIT REAL*8 (A-H,O-Z) 26 : 27 : -INC CCOPTIO 28 : -INC CCREEL 29 : 30 : -INC SMCOORD 31 : -INC SMCHAML 32 : -INC SMELEME 33 : -INC SMINTE 34 : -INC SMMODEL 35 : 36 : SEGMENT INFO 37 : INTEGER INFELL(JG) 38 : ENDSEGMENT 39 : 40 : SEGMENT MMAT1 41 : REAL*8 XEL(3,NBPTEL),AEL(NBPTEL,NBPTEL) 42 : ENDSEGMENT 43 : 44 : CHARACTER*(*) NOMDUA 45 : 46 : IPCHAL = 0 47 : 48 : C 1 - QUELQUES VERIFICATIONS SUR LES DONNEES 49 : C ============================================ 50 : MMODEL = IPMODL 51 : SEGACT,MMODEL 52 : NSOU = KMODEL(/1) 53 : C ===== 54 : C 1.1 - Verification de sources sur tout le modele 55 : C ===== 56 : MCHEL1 = IPCHSO 57 : SEGACT,MCHEL1 58 : IF (MCHEL1.IMACHE(/1).NE.NSOU) THEN 58 : CALL ERREUR(21) 59 : GOTO 120 60 : ENDIF 61 : C ===== 62 : C 1.2 - Verification de caracteristiques sur tout le modele 63 : C ===== 64 : C* Test effectue auparavant (cf. chal1.eso) 65 : C* IF (IPCHEB .EQ. 0) THEN 65 : C* CALL ERREUR(21) 66 : C* GOTO 120 67 : C* ENDIF 68 : MCHEL2 = IPCHEB 69 : SEGACT,MCHEL2 70 : IF (MCHEL2.IMACHE(/1).NE.NSOU) THEN 70 : CALL ERREUR(21) 71 : GOTO 110 72 : ENDIF 73 : 74 : C 2 - CREATION DU MCHAML GLOBAL (RESULTAT) 75 : C ========================================== 76 : L1=18 77 : N1=NSOU 78 : N3=6 79 : SEGINI,MCHELM 80 : C* IFOCHE=IFOMOD 81 : IFOCHE=IFOUR 82 : TITCHE='SOURCES.VOLUMIQUES' 83 : 84 : C 3 - BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE (ISOU) 85 : C ======================================================== 86 : ITHER = 0 87 : ITHHY = 0 88 : DO ISOU = 1, NSOU 89 : C ===== 90 : C 3.1 - Activation du modele elementaire ISOU 91 : C ===== 92 : IMODEL = KMODEL(ISOU) 93 : SEGACT,IMODEL 94 : C* Ici, NEF = 46 (EF BARRE !) 95 : NEF = NEFMOD 96 : C* On suppose que l'on a une FORMULATION unique (cf. chaleu.eso) 97 : IF (ISOU.EQ.1) THEN 98 : NFOR = FORMOD(/2) 98 : CALL PLACE(FORMOD,NFOR,ITHER,'THERMIQUE') 99 : IF (ITHER.EQ.0) 99 : & CALL PLACE(FORMOD,NFOR,ITHHY,'THERMOHYDRIQUE') 100 : ENDIF 101 : C ===== 102 : C 3.2 - Recuperation d'informations sur l'element fini du modele ISOU 103 : C ===== 104 : IF (ITHER.NE.0 .OR. ITHHY.NE.0) THEN 104 : CALL TSHAPE(NEF,'GAUSS',IPINTE) 105 : ELSE 106 : IF (INFMOD(/1).LT.5) THEN 106 : CALL ELQUOI(NEF,0,5,IPINF,IMODEL) 107 : IF (IERR.NE.0) GOTO 100 108 : INFO = IPINF 109 : IPINTE = INFELL(11) 110 : SEGSUP,INFO 111 : ELSE 112 : IPINTE = INFMOD(5) 113 : ENDIF 114 : ENDIF 115 : C ===== 116 : C 3.2 - Recherche dans le MCHAML des sources (IPCHSO) du maillage 117 : C (IMAMOD) associe au modele elementaire ISOU, puis recuperation 118 : C du MCHAML elementaire de sources associe (MELVA1) 119 : C ===== 120 : DO i = 1, NSOU 121 : IF (MCHEL1.IMACHE(i).EQ.IMAMOD) GOTO 10 122 : ENDDO 122 : CALL ERREUR(21) 123 : SEGSUP,MCHELM 124 : GOTO 100 125 : 10 CONTINUE 126 : MCHAM1 = MCHEL1.ICHAML(i) 127 : SEGACT,MCHAM1 128 : MELVA1 = MCHAM1.IELVAL(1) 129 : SEGDES,MCHAM1 130 : C ===== 131 : C 3.3 - Recherche dans le MCHMAL des caracteristiques (IPCHEB) du 132 : C maillage (IMAMOD) associe au modele elementaire ISOU, puis 133 : C recuperation du MCHAML elementaire associe (MELVA2) 134 : C ===== 135 : DO i = 1, NSOU 136 : IF (MCHEL2.IMACHE(i).EQ.IMAMOD) GOTO 20 137 : ENDDO 137 : CALL ERREUR(21) 138 : SEGSUP,MCHELM 139 : GOTO 100 140 : 20 CONTINUE 141 : MCHAM2 = MCHEL2.ICHAML(i) 142 : SEGACT,MCHAM2 143 : NCOELE = MCHAM2.NOMCHE(/2) 143 : CALL PLACE(MCHAM2.NOMCHE,NCOELE,IPOSI,'SECT') 144 : IF (IPOSI.EQ.0) THEN 145 : SEGDES,MCHAM2 146 : MOTERR(1:4) = 'SECT' 147 : MOTERR(5:8) = 'CARA' 147 : CALL ERREUR(77) 148 : SEGSUP,MCHELM 149 : GOTO 100 150 : ENDIF 151 : MELVA2 = MCHAM2.IELVAL(IPOSI) 152 : SEGDES,MCHAM2 153 : C ===== 154 : C 3.4 - Initialisation du MCHAML des flux de chaleur nodaux equivalents 155 : C (MCHAML) associe au modele elementaire ISOU (maillage IMAMOD) 156 : C Remplissage des donnees associees a MCHAML dans MCHELM (global) 157 : C ===== 158 : N2 = 1 159 : SEGINI,MCHAML 160 : NOMCHE(1) = NOMDUA 161 : TYPCHE(1) = 'REAL*8' 162 : IMACHE(ISOU) = IMAMOD 163 : ICHAML(ISOU) = MCHAML 164 : INFCHE(ISOU,3) = NIFOUR 165 : INFCHE(ISOU,6) = 1 166 : C ===== 167 : C 3.6 - Calcul des flux nodaux equivalents (segment MELVAL) 168 : C ===== 169 : C 3.6.1 - Recuperation d'informations sur le maillage elementaire 170 : MELEME = IMAMOD 171 : SEGACT,MELEME 172 : NBPTEL = NUM(/1) 173 : NbElt = NUM(/2) 174 : C 3.6.2 - Recuperation d'informations sur l'element fini du maillage 175 : MINTE = IPINTE 176 : SEGACT,MINTE 177 : NBPGAU = POIGAU(/1) 178 : C* NBNO = SHPTOT(/2) 179 : C 3.6.3 - Activation du MCHAML contenant les valeurs des sources 180 : SEGACT,MELVA1 181 : NBPTE1 = MELVA1.VELCHE(/1) 182 : NEL1 = MELVA1.VELCHE(/2) 183 : C 3.6.4 - Element fini BARRe : recuperation de la section 184 : SEGACT,MELVA2 185 : IF (IFOMOD.NE.0 .AND. IFOMOD.NE.1) THEN 186 : iBarre = 1 187 : iVA1 = MELVA2.VELCHE(/1) 188 : iMin1 = MIN(1,iVA1) 189 : iMin2 = MIN(2,iVA1) 190 : iVA2 = MELVA2.VELCHE(/2) 191 : ELSE 192 : iBarre = 0 193 : SMoy = 1. 194 : ENDIF 195 : C 3.6.5 - Initialisation du segment de travail MMAT1 196 : SEGINI,MMAT1 197 : C 3.6.6 - Initialisation du segment resultat MELVAL des valeurs 198 : C des flux nodaux pour chaque element du maillage (IMAMOD) 199 : N1PTEL = NBPTEL 200 : N1EL = NbElt 201 : N2PTEL = 0 202 : N2EL = 0 203 : SEGINI,MELVAL 204 : C 3.6.7 - Boucle sur les elements du maillage elementaire IMAMOD 205 : DO iElt = 1, NbElt 205 : CALL ZERO(AEL,NBPTEL,NBPTEL) 205 : CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,iElt,XEL) 206 : IF (iBarre.EQ.1) THEN 207 : i = MIN(iElt,iVA2) 208 : SMoy = (MELVA2.VELCHE(iMin1,i)+MELVA2.VELCHE(iMin2,i))*0.5 209 : ENDIF 210 : IF (IDIM.EQ.3) THEN 211 : DO iGau = 1, NBPGAU 212 : DLX = XZERO 213 : DLY = XZERO 214 : DLZ = XZERO 215 : DO i = 1,NBPTEL 216 : r_z = SHPTOT(2,i,iGau) 217 : DLX = DLX + r_z * XEL(1,i) 218 : DLY = DLY + r_z * XEL(2,i) 219 : DLZ = DLZ + r_z * XEL(3,i) 220 : ENDDO 221 : Volu = SMoy*SQRT(DLX*DLX+DLY*DLY+DLZ*DLZ)*POIGAU(iGau) 222 : DO i = 1, NBPTEL 223 : r_z = SHPTOT(1,i,iGau)*Volu 224 : DO j = 1, NBPTEL 225 : AEL(i,j) = AEL(i,j) + SHPTOT(1,j,iGau) * r_z 226 : ENDDO 227 : ENDDO 228 : ENDDO 229 : ELSE IF (IDIM.EQ.2) THEN 230 : DO iGau = 1, NBPGAU 231 : DLX = XZERO 232 : DLY = XZERO 233 : DO i = 1, NBPTEL 234 : r_z = SHPTOT(2,i,iGau) 235 : DLX = DLX + r_z * XEL(1,i) 236 : DLY = DLY + r_z * XEL(2,i) 237 : ENDDO 238 : Volu = SMoy*SQRT(DLX*DLX+DLY*DLY)*POIGAU(iGau) 239 : DO i = 1, NBPTEL 240 : r_z = SHPTOT(1,i,iGau)*Volu 241 : DO j = 1,NBPTEL 242 : AEL(i,j) = AEL(i,j) + SHPTOT(1,j,iGau) * r_z 243 : ENDDO 244 : ENDDO 245 : ENDDO 246 : ENDIF 247 : IEMIN = MIN(NEL1,iElt) 248 : DO i = 1, NBPTEL 249 : r_z = XZERO 250 : DO j = 1, NBPTEL 251 : k = MIN(NBPTE1,j) 252 : r_z = r_z + MELVA1.VELCHE(k,IEMIN) * AEL(j,i) 253 : ENDDO 254 : VELCHE(i,iElt) = r_z 255 : ENDDO 256 : ENDDO 257 : C 3.6.8 - Fin du traitement 258 : SEGSUP,MMAT1 259 : SEGDES,MELEME,MINTE 260 : SEGDES,MELVAL,MELVA1,MELVA2 261 : IF (IERR.NE.0) THEN 262 : SEGSUP,MCHELM 263 : GOTO 100 264 : ENDIF 265 : IELVAL(1)=MELVAL 266 : SEGDES,MCHAML 267 : ENDDO 268 : 269 : C 4 - MENAGE : DESACTIVATION DE SEGMENTS 270 : C ======================================== 271 : IPCHAL = MCHELM 272 : SEGDES,MCHELM 273 : 100 DO i = 1,NSOU 274 : IMODEL = KMODEL(i) 275 : SEGDES,IMODEL 276 : ENDDO 277 : 110 SEGDES,MCHEL2 278 : 120 SEGDES,MMODEL,MCHEL1 279 : 280 : RETURN 281 : END 282 : 283 : 284 :
© Cast3M 2003 - All rights reserved.
Disclaimer