1 : C FLUMAS SOURCE BP208322 13/07/30 21:15:06 7809 2 : 3 : C======================================================================= 4 : C= F L U M A S = 5 : C= ----------- = 6 : C= = 7 : C= Fonction : = 8 : C= ---------- = 9 : C= Calcul des flux nodaux equivalents a une condition de FLUX IMPOSE = 10 : C= pour des elements de type MASSIF (1D, 2D, 3D) = 11 : C= Sous-programme appele par FLUX2 (flux2.eso) = 12 : C= = 13 : C= Parametres : (E)=Entree (S)=Sortie = 14 : C= ------------ = 15 : C= IPMODE (E) Pointeur sur le segment MMODEL = 16 : C= IPGEOM (E) Objet MAILLAGE support de IPCHPO = 17 : C= IPCHPO (E) Pointeur sur le CHPOINT (ou le MCHAML) de flux = 18 : C= imposes aux noeuds de la structure = 19 : C= (champ variable ou constant) = 20 : C= NUMPOI (E) Vaut -1 si le flux impose est normal a la surface, = 21 : C= sinon pointeur sur un POINT correspondant a la = 22 : C= direction du flux (par rapport au repere global) = 23 : C= MOCOMP (E) Nom de la composante du champ de flux equivalents = 24 : C= MLMOTX (E) Pointeur MLMOTS de la liste des composantes de = 25 : C= IPCHPO associees aux 3 directions x,y,z. = 26 : C= IPFLUX (S) Pointeur sur le champ des flux nodaux equivalents = 27 : C= = 28 : C= Variables locales : = 29 : C= ------------------- = 30 : C= ITGEOM Pointeur sur un MAILLAGE elementaire du MASSIF = 31 : C= IPENVE Pointeur sur l'enveloppe d'un maillage MASSIF = 32 : C= IPGEOM Pointeur sur un MAILLAGE elementaire du CHPOINT = 33 : C= IPOGEO Pointeur sur un MAILLAGE commun au CHPOINT et au MASSIF = 34 : C= = 35 : C= Denis ROBERT, le 1er fevrier 1988. = 36 : C======================================================================= 37 : 38 : SUBROUTINE FLUMAS (IPMODE,IPGEOM,IPCHPO,NUMPOI,NOMCQ,MLMOTX, 39 : & IPFLUX) 40 : 41 : IMPLICIT INTEGER(I-N) 42 : IMPLICIT REAL*8 (A-H,O-Z) 43 : 44 : -INC CCOPTIO 45 : -INC CCHAMP 46 : -INC CCREEL 47 : -INC SMCHAML 48 : -INC SMCHPOI 49 : -INC SMMODEL 50 : -INC SMELEME 51 : -INC SMCOORD 52 : -INC SMLMOTS 53 : 54 : CHARACTER*(*) NOMCQ 55 : 56 : PARAMETER (XUn=1.) 57 : 58 : DIMENSION IVAL(4) 59 : CHARACTER*4 IMOT1,IMOT2 60 : 61 : C= Activation du MMODEL 62 : MMODEL=IPMODE 63 : SEGACT,MMODEL 64 : NSOU=KMODEL(/1) 65 : C= Activation de MLMOTX si defini 66 : NINC = 0 67 : IF (MLMOTX.NE.0) THEN 68 : MLMOTS=MLMOTX 69 : SEGACT,MLMOTS 70 : NINC = MOTS(/2) 71 : ENDIF 72 : 73 : C BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE 74 : C ============================================= 75 : idimp1=IDIM+1 76 : IRRT=0 77 : 78 : DO ISOU=1,NSOU 79 : 80 : IPCHEL=0 81 : 82 : IMODEL=KMODEL(ISOU) 83 : SEGACT,IMODEL 84 : NEF=NEFMOD 85 : 86 : * Determination de l'ENVELOPPE du MASSIF 87 : ITGEOM=IMAMOD 87 : CALL ECROBJ('MAILLAGE',ITGEOM) 88 : IF (IDIM.EQ.3) THEN 88 : CALL ENVELO 89 : ELSE IF (IDIM.EQ.2) THEN 89 : CALL PRCONT 90 : ELSE IF (IDIM.EQ.1) THEN 90 : CALL PREX1D 91 : ENDIF 91 : CALL LIROBJ('MAILLAGE',IPENVE,1,IRET) 92 : IF (IERR.NE.0) GOTO 9900 93 : 94 : * ON RECUPERE LES MAILLAGES ELEMENTAIRES DE L'ENVELOPPE 95 : * APPUYES STRICTEMENT SUR LE CHPOINT DE FLUX 95 : CALL ECROBJ('MAILLAGE',IPGEOM) 95 : CALL ECRCHA('STRI') 95 : CALL ECRCHA('APPU') 95 : CALL ECROBJ('MAILLAGE',IPENVE) 95 : CALL EXTREL(IRR,0,i) 96 : 97 : * Pas DE MAILLAGE COMMUN A CETTE PARTIE DE L'ENVELOPPE ET DU CHPOINT 98 : IF (IRR.EQ.1) THEN 99 : IRRT=IRRT+1 100 : GOTO 9900 101 : ENDIF 102 : 103 : * IL Y A DES MAILLAGES COMMUNS AU CHPOINT ET A L'ENVELOPPE 103 : CALL LIROBJ('MAILLAGE',IPOGEO,1,IRET) 104 : IF (IERR.NE.0) GOTO 9900 105 : * ON DESIRE CONNAITRE LES CARACTERISTIQUES DE CES MAILLAGES 106 : IPT3=IPOGEO 107 : SEGACT,IPT3 108 : NSOU3=IPT3.LISOUS(/1) 109 : IF (NSOU3.EQ.0) NBN2=IPT3.NUM(/1) 110 : 111 : * BOUCLE SUR LES ZONES DE CET OBJET GEOMETRIQUE 112 : DO IMAIL=1,MAX(1,NSOU3) 113 : IF (NSOU3.NE.0) THEN 114 : IPT2=IPT3.LISOUS(IMAIL) 115 : SEGACT,IPT2 116 : IPOGEO=IPT2 117 : NBN2=IPT2.NUM(/1) 118 : SEGDES,IPT2 119 : ENDIF 120 : * RECHERCHE DE LA FORMULATION DES (SUR)FACES POUR LES MASSIF 120 : CALL FLUX3(NEF,NBN2,NEFACE) 121 : * IMPOSSIBLE D'UTILISER L'OPERATEUR FLUX POUR LES ELEMENTS DE TYPE NEF 122 : IF (NEFACE.EQ.0) THEN 123 : MOTERR(1:4)=NOMTP(NEF) 123 : CALL ERREUR(407) 124 : GOTO 9901 125 : ENDIF 126 : * RECUPERATION DES CARACTERISTIQUES D'INTEGRATION 126 : CALL TSHAPE(NEFACE,'GAUSS',IPINTE) 127 : * ECHEC DANS L'ACQUISITION DES CARACTERISTIQUES D'INTEGRATION 128 : IF (IERR.NE.0) GOTO 9901 129 : 130 : * ON GENERE UN CHAMELEM ELEMENTAIRE DE FLUX 131 : * A PARTIR DU MAILLAGE ELEMENTAIRE DE POINTEUR IPOGEO 132 : * ET DU CHPOINT 133 : if (IPCHPO.gt.0) then 133 : CALL CHAME1(IPOGEO,0,IPCHPO,' ',ICHELF,6) 134 : else 135 : *ou ET DU MCHAML 136 : ICHE = -1*IPCHPO 136 : CALL REDUIC(ICHE,IPOGEO,ICHELF) 137 : endif 138 : MCHEL1=ICHELF 139 : IF (IERR.NE.0) GOTO 9901 140 : SEGACT,MCHEL1 141 : MCHAM1=MCHEL1.ICHAML(1) 142 : SEGDES,MCHEL1 143 : SEGACT,MCHAM1 144 : NBCOMP=MCHAM1.IELVAL(/1) 145 : IF (NBCOMP.EQ.1) THEN 146 : IPFLOD=MCHAM1.IELVAL(1) 147 : SEGDES,MCHAM1 148 : ELSE 149 : C POUR CHAQUE ELEMENT, 150 : C ON DETERMINE UN VECTEUR DIRIGE VERS L INTERIEUR DU MASSIF 151 : C A PARTIR D UN POINT DE LA FACE ET DU CENTRE DE GRAVITE DU MASSIF 152 : C ON COPIE LE CHAMP EN AJOUTANT UNE COMPOSANTE 153 : IF (MLMOTX.EQ.0) THEN 154 : MOTERR(1:8)='LISTMOTS' 154 : CALL ERREUR(37) 155 : GOTO 9901 156 : ENDIF 157 : MLMOTS=MLMOTX 158 : MELVAL=MCHAM1.IELVAL(1) 159 : SEGACT,MELVAL 160 : N1PTEL=VELCHE(/1) 161 : N1EL=VELCHE(/2) 162 : SEGDES,MELVAL 163 : N2PTEL=0 164 : N2EL=0 165 : NBCOMP=IDIM 166 : N2=NBCOMP+IDIM 167 : SEGINI,MCHAML 168 : IPFLOD=MCHAML 169 : DO I=1,N2 170 : SEGINI,MELVAL 171 : IELVAL(I)=MELVAL 172 : SEGDES,MELVAL 173 : ENDDO 174 : DO I=1,NINC 175 : IMOT1=MOTS(i) 176 : DO J=1,NINC 177 : IMOT2=MCHAM1.NOMCHE(J) 178 : IF (IMOT1.EQ.IMOT2) IVAL(I)=J 179 : ENDDO 180 : ENDDO 181 : DO I=1,NBCOMP 182 : MELVA1=MCHAM1.IELVAL(IVAL(I)) 183 : MELVAL=IELVAL(I) 184 : SEGACT,MELVAL*MOD,MELVA1 185 : DO j=1,N1EL 186 : DO k=1,N1PTEL 187 : VELCHE(k,j)=MELVA1.VELCHE(k,j) 188 : ENDDO 189 : ENDDO 190 : SEGDES,MELVA1 191 : ENDDO 192 : C activation des composantes supplementaires 193 : DO i=NBCOMP+1,N2 194 : MELVAL=IELVAL(i) 195 : SEGACT,MELVAL*MOD 196 : ENDDO 197 : NBPTE1=N1PTEL 198 : NEL1=N1EL 199 : SEGDES,MCHAM1 200 : NUMPOI=1 201 : MELEME=IPOGEO 202 : IPT1=ITGEOM 203 : SEGACT,MELEME,IPT1 204 : NBMA1=NUM(/1) 205 : DO IEF=1,NUM(/2) 206 : DO IEM=1,IPT1.NUM(/2) 207 : JNE=0 208 : DO INM=1,IPT1.NUM(/1) 209 : DO INF=1,NBMA1 210 : IF (IPT1.NUM(INM,IEM).EQ.NUM(INF,IEF)) JNE=JNE+1 211 : ENDDO 212 : ENDDO 213 : IF (JNE.EQ.NBMA1) GOTO 170 214 : ENDDO 215 : SEGDES,IPT1,MELEME 216 : DO j=1,N2 217 : MELVAL=IELVAL(j) 218 : SEGSUP,MELVAL 219 : ENDDO 220 : SEGDES,MCHAML 221 : *? Achtung SEGSUP,IPT3 222 : *? Erreur a voir 222 : CALL ERREUR(21) 223 : GOTO 9901 224 : C CDG element de "volume" 225 : C CDG de la "face" 226 : C Calcul de la normale interieure (stocker dans MCHAML) 227 : 170 NBM=IPT1.NUM(/1) 228 : IF (IDIM.EQ.2) THEN 229 : XG=XZero 230 : YG=XZero 231 : DO INM=1,NBM 232 : IREFM=(IPT1.NUM(INM,IEM)-1)*idimp1 233 : XG=XG+XCOOR(IREFM+1) 234 : YG=YG+XCOOR(IREFM+2) 235 : ENDDO 236 : XG=XG/NBM 237 : YG=YG/NBM 238 : XK=XZero 239 : YK=XZero 240 : DO INF=1,NBMA1 241 : IREFF=(NUM(INF,IEF)-1)*idimp1 242 : XK=XK+XCOOR(IREFF+1) 243 : YK=YK+XCOOR(IREFF+2) 244 : ENDDO 245 : XK=XK/NBMA1 246 : YK=YK/NBMA1 247 : V1=XG-XK 248 : V2=YG-YK 249 : VN=SQRT(V1*V1+V2*V2) 250 : V1=V1/VN 251 : V2=V2/VN 252 : DO INF=1,NBMA1 253 : MELVAL=IELVAL(NBCOMP+1) 254 : VELCHE(INF,IEF)=V1 255 : MELVAL=IELVAL(NBCOMP+2) 256 : VELCHE(INF,IEF)=V2 257 : ENDDO 258 : ELSE IF (IDIM.EQ.3) THEN 259 : XG=XZero 260 : YG=XZero 261 : ZG=XZero 262 : DO INM=1,NBM 263 : IREFM=(IPT1.NUM(INM,IEM)-1)*idimp1 264 : XG=XG+XCOOR(IREFM+1) 265 : YG=YG+XCOOR(IREFM+2) 266 : ZG=ZG+XCOOR(IREFM+3) 267 : ENDDO 268 : XG=XG/NBM 269 : YG=YG/NBM 270 : ZG=ZG/NBM 271 : XK=XZero 272 : YK=XZero 273 : ZK=XZero 274 : DO INF=1,NBMA1 275 : IREFF=(NUM(INF,IEF)-1)*idimp1 276 : XK=XK+XCOOR(IREFF+1) 277 : YK=YK+XCOOR(IREFF+2) 278 : ZK=ZK+XCOOR(IREFF+3) 279 : ENDDO 280 : XK=XK/NBMA1 281 : YK=YK/NBMA1 282 : ZK=ZK/NBMA1 283 : V1=XG-XK 284 : V2=YG-YK 285 : V3=ZG-ZK 286 : VN=SQRT(V1*V1+V2*V2+V3*V3) 287 : V1=V1/VN 288 : V2=V2/VN 289 : V3=V3/VN 290 : DO INF=1,NBMA1 291 : MELVAL=IELVAL(NBCOMP+1) 292 : VELCHE(INF,IEF)=V1 293 : MELVAL=IELVAL(NBCOMP+2) 294 : VELCHE(INF,IEF)=V2 295 : MELVAL=IELVAL(NBCOMP+3) 296 : VELCHE(INF,IEF)=V3 297 : ENDDO 298 : ELSE IF (IDIM.EQ.1) THEN 299 : XG=XZero 300 : DO INM=1,NBM 301 : IREFM=(IPT1.NUM(INM,IEM)-1)*idimp1 302 : XG=XG+XCOOR(IREFM+1) 303 : ENDDO 304 : XG=XG/NBM 305 : XK=XZero 306 : DO INF=1,NBMA1 307 : IREFF=(NUM(INF,IEF)-1)*idimp1 308 : XK=XK+XCOOR(IREFF+1) 309 : ENDDO 310 : XK=XK/NBMA1 311 : V1=XG-XK 312 : V1=V1/ABS(V1) 313 : DO INF=1,NBMA1 314 : MELVAL=IELVAL(NBCOMP+1) 315 : VELCHE(INF,IEF)=V1 316 : ENDDO 317 : ENDIF 318 : ENDDO 319 : DO j=1,IDIM 320 : MELVAL=IELVAL(NBCOMP+j) 321 : SEGDES,MELVAL 322 : ENDDO 323 : SEGDES,MCHAML 324 : SEGDES,IPT1,MELEME 325 : ENDIF 326 : * CHAMELEM ELEMENTAIRE DES FLUX NODAUX EQUIVALENTS 327 : L1=7 328 : N1=1 329 : N3=1 330 : SEGINI,MCHELM 331 : IPCHEL=MCHELM 332 : TITCHE='CHALEUR' 333 : IFOCHE=IFOUR 334 : INFCHE(1,1)=0 335 : IMACHE(1)=IPOGEO 336 : N2=1 337 : SEGINI,MCHAML 338 : ICHAML(1)=MCHAML 339 : NOMCHE(1)='FLUX' 340 : TYPCHE(1)='REAL*8' 341 : * CALCUL DES FLUX NODAUX EQUIVALENTS 342 : * FACES ASSOCIEES SEG2 OU SEG3 343 : IF (NEFACE.EQ.2.OR.NEFACE.EQ.3) THEN 343 : CALL FLUMA2(IPFLOD,IPOGEO,IPINTE,NUMPOI,IPFLEQ) 344 : * FACES ASSOCIEES TRI3,TRI6,QUA4 OU QUA8 345 : ELSE IF (NEFACE.EQ. 4.OR.NEFACE.EQ.6.OR.NEFACE.EQ.8.OR. 346 : . NEFACE.EQ.10) THEN 346 : CALL FLUMA3(IPFLOD,IPOGEO,IPINTE,NUMPOI,IPFLEQ) 347 : * FACES ASSOCIEES POI1 348 : ELSE IF (NEFACE.EQ.45) THEN 348 : CALL FLUMA1(IPFLOD,IPOGEO,IPINTE,NUMPOI,IPFLEQ) 349 : ENDIF 350 : IF (NUMPOI.EQ.1) THEN 351 : MCHAM2=IPFLOD 352 : SEGACT,MCHAM2 353 : DO i=1,MCHAM2.IELVAL(/1) 354 : MELVAL=MCHAM2.IELVAL(i) 355 : SEGSUP,MELVAL 356 : ENDDO 357 : SEGSUP,MCHAM2 358 : ENDIF 359 : IF (IERR.NE.0) THEN 360 : SEGSUP,MCHAML,MCHELM 361 : GOTO 9901 362 : ENDIF 363 : IELVAL(1)=IPFLEQ 364 : SEGDES,MCHAML,MCHELM 365 : * ON TRANSFORME LE CHAMELEM EN CHPOINT 365 : CALL CHAMPO(IPCHEL,0,IPCH1,IDUM) 366 : MCHPOI=IPCH1 367 : SEGACT,MCHPOI 368 : DO i=1,IPCHP(/1) 369 : MSOUPO=IPCHP(i) 370 : SEGACT,MSOUPO*MOD 371 : NOCOMP(1)=nomcq 372 : SEGDES,MSOUPO 373 : ENDDO 374 : SEGDES,MCHPOI 374 : CALL DTCHEL(IPCHEL) 375 : * ON REGROUPE,LE CAS ECHEANT,LES DIFFERENTS CHPOINTS 376 : IF ((ISOU-IRRT).GT.1.OR.IMAIL.GT.1) THEN 376 : CALL ADCHPO(IPCH1,IPFLUX,IRET,XUn,XUn) 377 : IF (IRET.EQ.0) GOTO 9901 377 : C* CALL ECRCHA('GEOM') 377 : CALL DTCHPO(IPCH1) 377 : C* CALL ECRCHA('GEOM') 377 : CALL DTCHPO(IPFLUX) 378 : IPFLUX=IRET 379 : ELSE 380 : IPFLUX=IPCH1 381 : ENDIF 382 : ENDDO 383 : 9901 CONTINUE 384 : SEGDES,IPT3 385 : 9900 CONTINUE 386 : SEGDES,IMODEL 387 : IF (IERR.NE.0) GOTO 9999 388 : ENDDO 389 : 390 : * IL N'EXISTE PAS D'ELEMENTS COMMUNS AU CHPOINT DES FLUX NODAUX 391 : * ET A L'ENVELOPPE DU MASSIF 391 : IF (IRRT.EQ.NSOU) CALL ERREUR(408) 392 : 393 : 9999 CONTINUE 394 : SEGDES,MMODEL 395 : IF (MLMOTX.NE.0) THEN 396 : MLMOTS = MLMOTX 397 : SEGDES,MLMOTS 398 : ENDIF 399 : 400 : RETURN 401 : END 402 : 403 : 404 : 405 :
© Cast3M 2003 - All rights reserved.
Disclaimer