1 : C FFDBIT SOURCE MAGN 10/05/18 21:15:28 6675 2 : SUBROUTINE FFDBIT(IZTUU,MELEME,IZIPAD,IAXI,QD,IMPR) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C************************************************************************ 6 : C 7 : C OPERATEUR DBIT 8 : C 9 : C CALCUL DU DEBIT D'UN VECTEUR A TRAVERS UNE SURFACE 10 : C SUR LE DOMAINE COURANT 11 : C 12 : C CALCUL EFFECTIF DU DEBIT. 13 : C 14 : C IZTUU : POINTEUR SUR LE CHPOINT-MPOVAL QUI DOIT ETRE DE TYPE VECT. 15 : C MELEME : POINTEUR SUR L'OBJET MAILLAGE 16 : C IZIPAD : Pointeur sur IPADL 17 : C QD : LE DEBIT 18 : C 19 : C 20 : C************************************************************************ 21 : 22 : PARAMETER (NLIS2=1,NLIS3=2) 23 : CHARACTER*8 LIST2(NLIS2),LIST3(NLIS3) 24 : CHARACTER*8 NOM0 25 : DIMENSION P2(2,2),P3(3,3),UI(3,9),UU(9) 26 : DIMENSION XN(3) 27 : 28 : -INC CCOPTIO 29 : -INC CCGEOME 30 : -INC SMCOORD 31 : -INC SMCHPOI 32 : POINTEUR IZTUU.MPOVAL 33 : -INC SMELEME 34 : -INC SIZFFB 35 : -INC SMLENTI 36 : 37 : 38 : C*** 39 : C 40 : DATA LIST2/'SEG2 '/ 41 : DATA LIST3/'TRI3 ','QUA4 '/ 42 : C 43 : C*** 44 : C INITIALISATION 45 : C 46 : ULP = 0. 47 : ULM = 0. 48 : QD=0. 49 : 50 : * 51 : * On peut y aller, les controles ont eu lieu dans DBIT 52 : * 53 : MLENTI=IZIPAD 54 : SEGACT IZTUU 55 : SEGACT MELEME 56 : NBSOUS=LISOUS(/1) 57 : IF(NBSOUS.EQ.0)NBSOUS=1 58 : DO 10 NS=1,NBSOUS 59 : IF(LISOUS(/1).EQ.0) IPT1 = MELEME 60 : IF(LISOUS(/1).NE.0) IPT1 = LISOUS(NS) 61 : SEGACT IPT1 62 : NBEL=IPT1.NUM(/2) 63 : NP=IPT1.NUM(/1) 64 : NOM0=NOMS(IPT1.ITYPEL)//' ' 64 : IF(IDIM.EQ.2)CALL OPTLI(IP,LIST2,NOM0,1) 64 : IF(IDIM.EQ.3)CALL OPTLI(IP,LIST3,NOM0,2) 65 : IF(IP.EQ.0)WRITE(6,*)' CET ELEMENT :',NOM0,': NE CONVIENT PAS ', 66 : & 'POUR CALCULER UN DEBIT EN ',IDIM,' D' 67 : IF(IP.EQ.0)RETURN 68 : 68 : CALL KALPBG(NOM0,'FONFORM ',IZFFM) 68 : IF(IZFFM.EQ.0)CALL ARRET(0) 69 : SEGACT IZFFM 70 : IZHR=KZHR(1) 71 : SEGACT IZHR*MOD 72 : 73 : NPG=GR(/3) 74 : NES=GR(/1) 75 : 76 : DO 20 K=1,NBEL 77 : 78 : DO 11 I=1,NP 79 : J=IPT1.NUM(I,K) 80 : DO 19 N=1,IDIM 81 : XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N) 82 : J1=LECT(J) 83 : UI(N,I)=IZTUU.VPOCHA(J1,N) 84 : 19 CONTINUE 85 : 11 CONTINUE 86 : 86 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE) 87 : 88 : IF(IDIM.EQ.3) THEN 89 : 89 : CALL CALJQB(XYZ,P3,IDIM,NP) 90 : DO 13 I=1,NP 91 : UU(I)=UI(1,I)*P3(3,1)+UI(2,I)*P3(3,2)+UI(3,I)*P3(3,3) 92 : 13 CONTINUE 93 : DO 133 KS=1,IDIM 94 : XN(KS)= P3(3,KS) 95 : 133 CONTINUE 96 : ELSE 97 : 97 : CALL CALJQB(XYZ,P2,IDIM,NP) 98 : DO 12 I=1,NP 99 : UU(I)=UI(1,I)*P2(2,1)+UI(2,I)*P2(2,2) 100 : 12 CONTINUE 101 : DO 122 KS=1,IDIM 102 : XN(KS)= P2(2,KS) 103 : 122 CONTINUE 104 : 105 : ENDIF 106 : 107 : UL=0. 108 : DO 14 I=1,NP 109 : DO 14 L=1,NPG 110 : UL=UL+UU(I)*FN(I,L)*PGSQ(L) 111 : 14 CONTINUE 112 : 113 : IF(UL.GT.0.)THEN 114 : ULP = ULP+UL 115 : ELSE 116 : ULM = ULM+UL 117 : ENDIF 118 : QD=QD+UL 119 : 20 CONTINUE 120 : IF(LISOUS(/1).NE.0) SEGDES IPT1 121 : 10 CONTINUE 122 : SEGDES MELEME,IZTUU 123 : SEGSUP IZHR,IZFFM 124 : 125 : IF(IMPR.NE.0)THEN 126 : WRITE(6,*)' DEBIT GLOBAL DANS LE SENS DE LA NORMALE = ',ULP 127 : WRITE(6,*)' DEBIT GLOBAL DANS LE SENS OPPOSE A LA NORMALE =',ULM 128 : ENDIF 129 : C****************************************************** 130 : 131 : RETURN 132 : END 133 : 134 : 135 : 136 : 137 : 138 : 139 : 140 : 141 :
© Cast3M 2003 - All rights reserved.
Disclaimer