1 : C FLUMA3 SOURCE PV 09/03/12 21:22:51 6325 2 : SUBROUTINE FLUMA3(IPFLOD,IPGEOM,IPINTE,NUMPOI,IPFLEQ) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : ************************************************************************ 6 : * 7 : * F L U M A 3 8 : * ----------- 9 : * 10 : * FONCTION: 11 : * --------- 12 : * CALCUL DES FLUX NODAUX EQUIVALENTS 13 : * MODE TRIDIMENSIONNEL 14 : * 15 : * MODULES UTILISES: 16 : * ----------------- 17 : * 18 : -INC CCOPTIO 19 : -INC CCREEL 20 : -INC SMCHAML 21 : -INC SMELEME 22 : -INC SMINTE 23 : -INC SMCOORD 24 : * 25 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 26 : * ----------- 27 : * 28 : * IPFLOD (E) POINTEUR SUR UN SEGMENT MELVAL CONTENANT LES 29 : * FLUX NODAUX 30 : * IPGEOM (E) POINTEUR SUR UN OBJET MAILLAGE ELEMENTAIRE 31 : * DE L'ENVELOPPE 32 : * IPINTE (E) POINTEUR SUR UN SEGMENT MINTE CONTENANT LES 33 : * CARACTERISTIQUES D'INTEGRATION DES FACES 34 : * +IDIM (E) VOIR CCOPTIO 35 : * +XZERO (E) VOIR CCREEL 36 : * +XPETIT (E) VOIR CCREEL 37 : * NUMPOI (E) REFERENCE LA DIRECTION DU FLUX DANS LE REPERE GLOBAL 38 : * = -1 LORSQUE LE FLUX EST NORMAL A LA SURFACE 39 : * MIS A 1 POUR LA SYNTAXE 3 ( FLUX D UN VECTEUR) 40 : * IPFLEQ (S) POINTEUR SUR UN SEGMENT MELVAL CONTENANT LES 41 : * FLUX NODAUX EQUIVALENTS 42 : * 43 : INTEGER NUMPOI 44 : * 45 : * VARIABLES: 46 : * ---------- 47 : * 48 : * XE(3,NBPTEL) = COORDONNEES DES ELEMENTS DANS LE REPERE GLOBAL 49 : * SURF = SURFACE ELEMENTAIRE AU POINT DE GAUSS 50 : * A ET S = TABLEAUX DE TRAVAIL 51 : * COSDIR = COSINUS DIRECTEUR DE L'INCLINAISON DU FLUX 52 : * 53 : REAL*8 S(6) 54 : SEGMENT,MMAT1 55 : REAL*8 XE(3,NBPTEL) 56 : ENDSEGMENT 57 : * 58 : * CONSTANTES: 59 : * ----------- 60 : * 61 : PARAMETER ( O1=1.D0 ) 62 : PARAMETER ( O4=4.D0 ) 63 : * 64 : * AUTEUR, DATE DE CREATION: 65 : * ------------------------- 66 : * 67 : * DENIS ROBERT,LE 3 FEVRIER 1988. 68 : * 69 : * LANGAGE: 70 : * -------- 71 : * 72 : * ESOPE + FORTRAN77 73 : * 74 : ************************************************************************ 75 : * 76 : * ON RECUPERE LES VALEURS NODALES DU FLUX 77 : 78 : * 79 : IF (NUMPOI.NE.1) THEN 80 : 81 : MELVA1=IPFLOD 82 : SEGACT,MELVA1 83 : NBPTE1=MELVA1.VELCHE(/1) 84 : NEL1=MELVA1.VELCHE(/2) 85 : ELSE 86 : * numpoi a ete mis a 1 si ipflod a 2 ou 3 composantes ......... 87 : 88 : MCHAM1 = IPFLOD 89 : SEGACT,MCHAM1 90 : MELVA1= MCHAM1.IELVAL(1) 91 : MELVA2= MCHAM1.IELVAL(2) 92 : MELVA3= MCHAM1.IELVAL(3) 93 : MELVA4= MCHAM1.IELVAL(4) 94 : MELVA5= MCHAM1.IELVAL(5) 95 : MELVA6= MCHAM1.IELVAL(6) 96 : 97 : 98 : SEGACT,MELVA1,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6 99 : NBPTE1=MELVA1.VELCHE(/1) 100 : NEL1=MELVA1.VELCHE(/2) 101 : SEGDES,MCHAM1 102 : ENDIF 103 : * 104 : * ON RECUPERE LES CARACTERISTIQUES D'INTEGRATION DES FACES 105 : * 106 : MINTE=IPINTE 107 : SEGACT,MINTE 108 : NBPGAU=POIGAU(/1) 109 : * 110 : * ON RECUPERE UN DES MAILLAGES ELEMENTAIRES DE L'ENVELOPPE 111 : * 112 : MELEME=IPGEOM 113 : SEGACT,MELEME 114 : NBPTEL=NUM(/1) 115 : NEL=NUM(/2) 116 : * 117 : * MELVAL QUI CONTIENDRA LES FLUX NODAUX EQUIVALENTS 118 : * 119 : N1PTEL=NBPTEL 120 : N1EL=NEL 121 : N2PTEL=0 122 : N2EL=0 123 : SEGINI,MELVAL 124 : IPFLEQ=MELVAL 125 : SEGINI,MMAT1 126 : * 127 : * CAS D'UN FLUX INCLINE PAR RAPPORT A LA NORMALE A LA SURFACE 128 : * 129 : COSDIR=O1 130 : IF ((NUMPOI.NE.-1).AND.(NUMPOI.NE.1)) THEN 131 : * 132 : * ON RECUPERE LES COORDONNEES DU VECTEUR DIRECTION 133 : * 133 : CALL EXCOO1(NUMPOI,XDIR,YDIR,ZDIR,DENS) 134 : DNORME=SQRT(XDIR**2+YDIR**2+ZDIR**2) 135 : IF (DNORME.LT.XPETIT) THEN 136 : * 137 : * ERREUR DANS LA DONNEE DE LA DIRECTION DU FLUX 138 : * 138 : CALL ERREUR(417) 139 : RETURN 140 : ENDIF 141 : XDIRNO=XDIR/DNORME 142 : YDIRNO=YDIR/DNORME 143 : ZDIRNO=ZDIR/DNORME 144 : COSDIR=O4 145 : ENDIF 146 : 147 : 148 : 149 : * 150 : * BOUCLE SUR LES ELEMENTS 151 : * 152 : DO 10 IEL=1,NEL 153 : * 154 : * ON CHERCHE LES COORDONNEES DES NOEUDS DANS LE REPERE GLOBAL 155 : * 155 : CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IEL,XE) 156 : * 157 : * BOUCLE SUR LES POINTS DE GAUSS ET SUR LES NOEUDS 158 : 159 : DO 40 IGAU=1,NBPGAU 160 : * 161 : * CALCUL DE LA SURFACE ELEMENTAIRE AU POINT DE GAUSS 162 : * 163 : SURFX=XZERO 164 : SURFY=XZERO 165 : SURFZ=XZERO 166 : DO 21 I=1,6 167 : S(I)=XZERO 168 : 21 CONTINUE 169 : * END DO 170 : DO 30 INOE=1,NBPTEL 171 : S(1)=S(1)+SHPTOT(2,INOE,IGAU)*XE(2,INOE) 172 : S(2)=S(2)+SHPTOT(3,INOE,IGAU)*XE(3,INOE) 173 : S(3)=S(3)+SHPTOT(3,INOE,IGAU)*XE(2,INOE) 174 : S(4)=S(4)+SHPTOT(2,INOE,IGAU)*XE(3,INOE) 175 : S(5)=S(5)+SHPTOT(3,INOE,IGAU)*XE(1,INOE) 176 : S(6)=S(6)+SHPTOT(2,INOE,IGAU)*XE(1,INOE) 177 : 30 CONTINUE 178 : * END DO 179 : SURFX=S(1)*S(2)-S(3)*S(4) 180 : SURFY=S(4)*S(5)-S(2)*S(6) 181 : SURFZ=S(6)*S(3)-S(5)*S(1) 182 : SURF=SQRT(SURFX**2+SURFY**2+SURFZ**2) 183 : 184 : * 185 : * SI ON A UN FLUX INCLINE,CALCUL DU COSINUS DIRECTEUR 186 : * 187 : IGMN=MIN(IGAU,MELVA1.VELCHE(/1)) 188 : IBMN=MIN(IEL,MELVA1.VELCHE(/2)) 189 : DIRNOR=COSDIR 190 : IF ((COSDIR.NE.O1).AND.(NUMPOI.NE.1)) THEN 191 : DIRNOR=ABS(XDIRNO*(SURFX/SURF)+YDIRNO*(SURFY/SURF) 192 : + +ZDIRNO*(SURFZ/SURF)) 193 : 194 : ENDIF 195 : 196 : 197 : IF (NUMPOI.EQ.1) THEN 198 : C on oriente la vraie normale suivant la pseudo 199 : S1 = MELVA4.VELCHE(IGMN,IBMN) 200 : S2 = MELVA5.VELCHE(IGMN,IBMN) 201 : S3 = MELVA6.VELCHE(IGMN,IBMN) 202 : AMUL = 1.D0 203 : PS = SURFX*S1+SURFY*S2+SURFZ*S3 204 : IF(PS.LT.0) AMUL = -1.D0 205 : T1 = ( POIGAU(IGAU)*( MELVA1.VELCHE(IGMN,IBMN)*SURFX + 206 : 1 MELVA2.VELCHE(IGMN,IBMN)*SURFY + 207 : 1 MELVA3.VELCHE(IGMN,IBMN)*SURFZ ))*AMUL 208 : ELSE 209 : T1 = POIGAU(IGAU)*DIRNOR*SURF*MELVA1.VELCHE(IGMN,IBMN) 210 : ENDIF 211 : DO 51 J=1,NBPTEL 212 : VELCHE(J,IEL) = VELCHE(J,IEL) +SHPTOT(1,J,IGAU)*T1 213 : 214 : 51 CONTINUE 215 : 40 CONTINUE 216 : 10 CONTINUE 217 : * END DO 218 : * 219 : SEGSUP,MMAT1 220 : SEGDES,MELEME,MELVA1,MINTE 221 : SEGDES,MELVAL 222 : IF ( NUMPOI.EQ.1) THEN 223 : SEGDES MELVA2,MELVA3,MELVA4,MELVA5,MELVA6 224 : ENDIF 225 : * 226 : END 227 : 228 : 229 : 230 : 231 : 232 : 233 :
© Cast3M 2003 - All rights reserved.
Disclaimer