1 : C CHACO2 SOURCE PV 09/03/12 21:16:41 6325 2 : SUBROUTINE CHACO2(IPSONO,IPSON1,IPSON2,IEP,IPGEOM,IPINTE, 3 : . IPINT1,IPCHEQ,IPCHE1,IPCHE2) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : ************************************************************************ 7 : * 8 : * C H A C O 2 9 : * ----------- 10 : * 11 : * FONCTION: 12 : * --------- 13 : * CAS DES SOURCES VOLUMIQUES 14 : * COQ6 COQ8 ET COQ4 15 : * 16 : * MODULES UTILISES: 17 : * ----------------- 18 : * 19 : -INC CCOPTIO 20 : -INC CCREEL 21 : -INC SMCHAML 22 : -INC SMELEME 23 : -INC SMINTE 24 : -INC SMCOORD 25 : * 26 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 27 : * ----------- 28 : * 29 : * IPSONO (E) POINTEURS SUR DES SEGMENTS MELVAL CONTENANT LES 30 : * IPSON1 SOURCES 31 : * IPSON2 32 : * IEP (E) POINTEUR SUR UN SEGMENT MELVAL COTENANT LES EPAISSEUR 33 : * IPGEOM (E) POINTEUR SUR UN OBJET MAILLAGE ELEMENTAIRE 34 : * IPINTE (E) POINTEUR SUR UN SEGMENT MINTE CONTENANT LES 35 : * CARACTERISTIQUES D'INTEGRATION 36 : * IPINT1 (E) POINTEUR SUR UN SEGMENT MINTE CONTENANT LES 37 : * LES VALEURS DE FONCTION DE FORME AUX NOEUD 38 : * +IDIM (E) VOIR CCOPTIO 39 : * +XPI (E) VOIR CCREEL 40 : * IPCHEQ (S) POINTEURS SUR DES SEGMENTS MELVAL CONTENANT LES 41 : * IPCHE1 CHALEURS NODALES EQUIVALENTES 42 : * IPCHE2 43 : * 44 : * VARIABLES: 45 : * ---------- 46 : * 47 : * XE(3,NBPTEL) = COORDONNEES DES ELEMENTS DANS LE REPERE GLOBAL 48 : * DJAC = DETERMINANT DU JACOBIEN EN UN POINT DE GAUSS 49 : * A ET A1 = TABLEAUX DE TRAVAIL 50 : * 51 : * 52 : REAL*8 XJ(3,3) 53 : SEGMENT,MMAT1 54 : REAL*8 XE(3,NBPTEL),A(NBE,NBE),FORME(NBNO),A1(NBNO,NBNO) 55 : REAL*8 EXC(NBNO),EPAI(NBNO),TXR(3,3,NBNO) 56 : ENDSEGMENT 57 : * 58 : * CONSTANTES: 59 : * ----------- 60 : * 61 : PARAMETER ( O1=1.D0,O2=2.D0) 62 : DATA X577/.577350269189626D0/ 63 : * 64 : * AUTEUR, DATE DE CREATION: 65 : * ------------------------- 66 : * 67 : * P. DOWLATYARI AOUT 90 68 : * 69 : * LANGAGE: 70 : * -------- 71 : * 72 : * ESOPE + FORTRAN77 73 : * 74 : ************************************************************************ 75 : * 76 : * ON RECUPERE LES VALEURS DES SOURCES 77 : * 78 : MELVA1=IPSONO 79 : SEGACT,MELVA1 80 : NBPTE1=MELVA1.VELCHE(/1) 81 : NEL1=MELVA1.VELCHE(/2) 82 : MELVA2=IPSON1 83 : SEGACT,MELVA2 84 : MELVA3=IPSON2 85 : SEGACT,MELVA3 86 : * 87 : * ON RECUPERE LES CARACTERISTIQUES D'INTEGRATION 88 : * 89 : MINTE=IPINTE 90 : SEGACT,MINTE 91 : NBPGAU=POIGAU(/1) 92 : NBNO=SHPTOT(/2) 93 : MINTE1 = IPINT1 94 : SEGACT,MINTE1 95 : * 96 : * ON RECUPERE UN DES MAILLAGES ELEMENTAIRES DE L'ENVELOPPE 97 : * 98 : MELEME=IPGEOM 99 : SEGACT,MELEME 100 : NBPTEL=NUM(/1) 101 : NEL=NUM(/2) 102 : * 103 : * INITIALISATION DES MELVALS QUI CONTIENDRA LES CHALEURS EQUIVALENTE 104 : * 105 : N1PTEL=NBPTEL 106 : N1EL=NEL 107 : N2PTEL=0 108 : N2EL=0 109 : NBE=3*NBPTEL 110 : SEGINI,MELVAL 111 : IPCHEQ=MELVAL 112 : SEGINI,MELVA4 113 : IPCHE1=MELVA4 114 : SEGINI,MELVA5 115 : IPCHE2=MELVA5 116 : SEGINI,MMAT1 116 : CALL ZERO(EXC,NBNO,1) 117 : MELVA6=IEP 118 : SEGACT,MELVA6 119 : * 120 : * BOUCLE SUR LES ELEMENTS 121 : * 122 : DO 10 IEL=1,NEL 123 : * 124 : * ON CHERCHE LES COORDONNEES DES NOEUDS DANS LE REPERE GLOBAL 125 : * 125 : CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IEL,XE) 126 : * 127 : * CALCUL DES AXES LOCAUX AUX NOEUDS DE L'ELEMENT 128 : * 128 : CALL CQ8LOC(XE,NBPTEL,MINTE1.SHPTOT,TXR,IRR) 129 : * 130 : IF(IRR.EQ.0)THEN 131 : * 132 : * EHEC DANS LE CALCUL DES AXES LOCAUX 133 : * 133 : CALL ERREUR (515) 134 : SEGSUP,MMAT1,MELVAL,MELVA4,MELVA5 135 : SEGDES,MELEME,MELVA1,MINTE,MELVA2,MELVA6 136 : SEGDES,MINTE1,MELVA3 137 : RETURN 138 : ENDIF 139 : * 140 : * 141 : * ON CREE LE TABLEAU DES EPAISSEURS 142 : * 143 : IBMN=MIN(IEL,MELVA6.VELCHE(/2)) 144 : DO 5 INO = 1,NBNO 145 : INMN=MIN(INO,MELVA6.VELCHE(/1)) 146 : EPAI(INO) =MELVA6.VELCHE(INMN,IBMN) 147 : 5 CONTINUE 148 : * 148 : CALL ZERO (A,NBE,NBE) 149 : * 150 : * BOUCLE SUR LES POINTS DE GAUSS 151 : * 152 : * 153 : DO 40 IGAU = 1, NBPGAU 154 : * 154 : CALL ZERO (A1,NBNO,NBNO) 155 : * 156 : E3=DZEGAU(IGAU) 157 : * 158 : * 159 : * CALCUL DU JACABIEN 160 : * 160 : CALL CQ8JCE (IGAU,NBPTEL,E3,XE,EPAI,EXC,TXR,SHPTOT, 161 : . XJ,DJAC,IRR) 162 : * 163 : IF(IRR.LT.0)THEN 164 : * 165 : * JACOBIEN NUL DANS L'ELEMENT IEL 166 : * 167 : INTERR(1)=IEL 167 : CALL ERREUR (405) 168 : SEGSUP,MMAT1,MELVAL,MELVA4,MELVA5 169 : SEGDES,MELEME,MELVA1,MINTE,MELVA2,MELVA6 170 : SEGDES,MINTE1,MELVA3 171 : RETURN 172 : ENDIF 173 : * 174 : * CALCUL DE FORME (TRANSPOSEE)*FORME CONCERNANT LA SURFACE 175 : * MOYENNE 176 : DO 50 INO=1,NBNO 177 : FORME(INO)=SHPTOT(1,INO,IGAU) 178 : 50 CONTINUE 179 : * 180 : DJAC = DJAC*POIGAU(IGAU) 181 : * 181 : CALL NTNST (FORME,DJAC,NBNO,1,A1) 182 : * 183 : * ON AJOUTE L'EFFET DE L'EPAISSEUR 184 : * 185 : C1=(E3/O2)*(E3-O1) 186 : C2=O1-E3*E3 187 : C3=(E3/O2)*(E3+O1) 188 : * 189 : DO 60 I=1,NBE 190 : DO 60 J=1,NBE 191 : IF(I.LE.NBNO)THEN 192 : II=I 193 : IF(J.LE.NBNO)THEN 194 : JJ=J 195 : FACT=C1*C1 196 : ELSEIF(J.GT.NBNO.AND.J.LE.(2*NBNO))THEN 197 : JJ=J-NBNO 198 : FACT=C1*C2 199 : ELSE 200 : JJ=J-2*NBNO 201 : FACT=C1*C3 202 : ENDIF 203 : ELSEIF(I.GT.NBNO.AND.I.LE.(2*NBNO))THEN 204 : II=I-NBNO 205 : IF(J.LE.NBNO)THEN 206 : JJ=J 207 : FACT=C2*C1 208 : ELSEIF(J.GT.NBNO.AND.J.LE.(2*NBNO))THEN 209 : JJ=J-NBNO 210 : FACT=C2*C2 211 : ELSE 212 : JJ=J-2*NBNO 213 : FACT=C2*C3 214 : ENDIF 215 : ELSE 216 : II=I-2*NBNO 217 : IF(J.LE.NBNO)THEN 218 : JJ=J 219 : FACT=C3*C1 220 : ELSEIF(J.GT.NBNO.AND.J.LE.(2*NBNO))THEN 221 : JJ=J-NBNO 222 : FACT=C3*C2 223 : ELSE 224 : JJ=J-2*NBNO 225 : FACT=C3*C3 226 : ENDIF 227 : ENDIF 228 : A(I,J)=A(I,J)+FACT*A1(II,JJ) 229 : 60 CONTINUE 230 : * FIN DE BOUCLE SUR LES POINTS D'INTEGRATION 231 : 40 CONTINUE 232 : * 233 : * (INTEGRAL DE HTH)*VALEURS NODALES DES SOURCES 234 : * 235 : IEMIN=MIN(NEL1,IEL) 236 : DO 70 INO3=1,NBE 237 : DO 70 INO4=1,NBE 238 : IF(INO3.LE.NBPTEL)THEN 239 : IF(INO4.LE.NBPTEL)THEN 240 : INMIN=MIN(NBPTE1,INO4) 241 : VELCHE(INO3,IEL)=VELCHE(INO3,IEL)+MELVA1.VELCHE(INMIN,IEMIN)* 242 : 1 A(INO4,INO3) 243 : ELSEIF(INO4.GT.NBPTEL.AND.INO4.LE.(2*NBPTEL))THEN 244 : INO5=INO4-NBPTEL 245 : INMIN=MIN(NBPTE1,INO5) 246 : VELCHE(INO3,IEL)=VELCHE(INO3,IEL)+MELVA2.VELCHE(INMIN,IEMIN)* 247 : 1 A(INO4,INO3) 248 : ELSE 249 : INO5=INO4-2*NBPTEL 250 : INMIN=MIN(NBPTE1,INO5) 251 : VELCHE(INO3,IEL)=VELCHE(INO3,IEL)+MELVA3.VELCHE(INMIN,IEMIN)* 252 : 1 A(INO4,INO3) 253 : ENDIF 254 : ELSEIF(INO3.GT.NBPTEL.AND.INO3.LE.(2*NBPTEL))THEN 255 : INO6=INO3 - NBPTEL 256 : IF(INO4.LE.NBPTEL)THEN 257 : INMIN=MIN(NBPTE1,INO4) 258 : MELVA4.VELCHE(INO6,IEL)=MELVA4.VELCHE(INO6,IEL)+ 259 : 1 MELVA1.VELCHE(INMIN,IEMIN)*A(INO4,INO3) 260 : ELSEIF(INO4.GT.NBPTEL.AND.INO4.LE.(2*NBPTEL))THEN 261 : INO5=INO4-NBPTEL 262 : INMIN=MIN(NBPTE1,INO5) 263 : MELVA4.VELCHE(INO6,IEL)=MELVA4.VELCHE(INO6,IEL)+ 264 : 1 MELVA2.VELCHE(INMIN,IEMIN)*A(INO4,INO3) 265 : ELSE 266 : INO5=INO4-2*NBPTEL 267 : INMIN=MIN(NBPTE1,INO5) 268 : MELVA4.VELCHE(INO6,IEL)=MELVA4.VELCHE(INO6,IEL)+ 269 : 1 MELVA3.VELCHE(INMIN,IEMIN)*A(INO4,INO3) 270 : ENDIF 271 : ELSE 272 : INO6=INO3 -2*NBPTEL 273 : IF(INO4.LE.NBPTEL)THEN 274 : INMIN=MIN(NBPTE1,INO4) 275 : MELVA5.VELCHE(INO6,IEL)=MELVA5.VELCHE(INO6,IEL)+ 276 : 1 MELVA1.VELCHE(INMIN,IEMIN)*A(INO4,INO3) 277 : ELSEIF(INO4.GT.NBPTEL.AND.INO4.LE.(2*NBPTEL))THEN 278 : INO5=INO4-NBPTEL 279 : INMIN=MIN(NBPTE1,INO5) 280 : MELVA5.VELCHE(INO6,IEL)=MELVA5.VELCHE(INO6,IEL)+ 281 : 1 MELVA2.VELCHE(INMIN,IEMIN)*A(INO4,INO3) 282 : ELSE 283 : INO5=INO4-2*NBPTEL 284 : INMIN=MIN(NBPTE1,INO5) 285 : MELVA5.VELCHE(INO6,IEL)=MELVA5.VELCHE(INO6,IEL)+ 286 : 1 MELVA3.VELCHE(INMIN,IEMIN)*A(INO4,INO3) 287 : ENDIF 288 : ENDIF 289 : 70 CONTINUE 290 : * END DO 291 : 10 CONTINUE 292 : * END DO 293 : * 294 : SEGSUP,MMAT1 295 : SEGDES,MELEME,MELVA1,MINTE,MELVA2,melva6 296 : SEGDES,MELVA3,MELVAL,MELVA4,MELVA5,MINTE1 297 : * 298 : END 299 : 300 : 301 : 302 : 303 : 304 :
© Cast3M 2003 - All rights reserved.
Disclaimer