1 : C KFDBIT SOURCE MAGN 10/05/18 21:15:36 6675 2 : SUBROUTINE KFDBIT(IZTUU,MELEME,IZIPAD,IAXI,QD,ULP,ULM,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 : 23 : -INC CCOPTIO 24 : -INC CCGEOME 25 : -INC SMCOORD 26 : -INC SMCHPOI 27 : POINTEUR IZTUU.MPOVAL 28 : -INC SMELEME 29 : -INC SIZFFB 30 : -INC SMLENTI 31 : -INC CCREEL 32 : CHARACTER*8 NOM0 33 : DIMENSION ULN(3) 34 : C*** 35 : C 36 : C 37 : C*** 38 : IAXI=0 39 : IF(IFOMOD.EQ.0)IAXI=1 40 : DEUPI=1.D0 41 : IF(IAXI.NE.0)DEUPI=2.D0*XPI 42 : 43 : ULP = 0.D0 44 : ULM = 0.D0 45 : QD=0.D0 46 : 47 : * 48 : * On peut y aller, les controles ont eu lieu dans DBIT 49 : * 50 : MLENTI=IZIPAD 51 : SEGACT IZTUU 52 : SEGACT MELEME 53 : NBSOUS=LISOUS(/1) 54 : IF(NBSOUS.EQ.0)NBSOUS=1 55 : DO 10 NS=1,NBSOUS 56 : IPT1 = MELEME 57 : IF(LISOUS(/1).NE.0) IPT1 = LISOUS(NS) 58 : SEGACT IPT1 59 : NBEL=IPT1.NUM(/2) 60 : NP=IPT1.NUM(/1) 61 : NOM0=NOMS(IPT1.ITYPEL)//' ' 62 : 62 : CALL KALPBG(NOM0,'FONFORM ',IZFFM) 63 : 64 : IF(IZFFM.EQ.0)THEN 65 : C% Type d'élément incorrect 65 : CALL ERREUR(16) 66 : RETURN 67 : ENDIF 68 : 69 : SEGACT IZFFM*MOD 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 19 N=1,IDIM 79 : DO 11 I=1,NP 80 : J=IPT1.NUM(I,K) 81 : XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N) 82 : 11 CONTINUE 83 : 19 CONTINUE 84 : 84 : CALL CALJBR 85 : & (FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN) 86 : C do 73964 ll=1,npg 87 : C write(6,*)'AJ' 88 : C write(6,1002)((aj(ii,jj,ll),ii=1,idim),jj=1,idim) 89 : C73964 continue 90 : 91 : U=0.D0 92 : DO 14 L=1,NPG 93 : UNL=0.D0 94 : DO 12 N=1,IDIM 95 : ULN(N)=0.D0 96 : DO 13 I=1,NP 97 : I1=LECT(IPT1.NUM(I,K)) 98 : ULN(N)=ULN(N)+FN(I,L)*IZTUU.VPOCHA(I1,N) 99 : 13 CONTINUE 100 : UNL=UNL+ULN(N)*AJ(N,IDIM,L) 101 : 12 CONTINUE 102 : U=U+UNL*PGSQ(L)*DEUPI*RPG(L) 103 : 14 CONTINUE 104 : 105 : 106 : IF(U.GT.0.D0)THEN 107 : ULP = ULP+U 108 : ELSE 109 : ULM = ULM+U 110 : ENDIF 111 : QD=QD+U 112 : 20 CONTINUE 113 : IF(LISOUS(/1).NE.0) SEGDES IPT1 114 : 10 CONTINUE 115 : SEGDES MELEME,IZTUU 116 : SEGSUP IZHR,IZFFM 117 : 118 : IF(IMPR.NE.0)THEN 119 : WRITE(6,*)' DEBIT GLOBAL DANS LE SENS DE LA NORMALE = ',ULP 120 : WRITE(6,*)' DEBIT GLOBAL DANS LE SENS OPPOSE A LA NORMALE =',ULM 121 : write(6,*)' DEBIT TOTAL QD=',QD 122 : ENDIF 123 : C****************************************************** 124 : 125 : RETURN 126 : 1002 FORMAT(10(1X,1PE11.4)) 127 : END 128 : 129 : 130 : 131 : 132 : 133 : 134 : 135 : 136 : 137 :
© Cast3M 2003 - All rights reserved.
Disclaimer