1 : C FDE23D SOURCE PV 09/03/12 21:22:34 6325 2 : SUBROUTINE FDE23D(IPTVPR,IPMAIL,IPTINT,IVAFOR,IELI) 3 : C_______________________________________________________________________ 4 : C 5 : C CALCULE LES FORCES DE DEBITS SUR LES FACES D ELEMENTS 6 : C MASSIFS ( INSPIRE DE FPMA2D ET FPMA3D ) 7 : C 8 : C ENTREES : 9 : C --------- 10 : C 11 : C IPTVPR POINTEUR SUR UN MELVAL CONTENANT LES PRESSIONS APPLIQUEES 12 : C IPMAIL POINTEUR SUR UN OBJET GEOMETRIQUE 13 : C IPTINT POINTEUR SUR UN MINTE CONTENANT LES POINTS D INTEGRATION 14 : C IVAFOR POINTEUR SUR UN MPTVAL ET LES MELVAL CONTENANT LES FORCES 15 : C NODALES RESUL 16 : C IELI NUMERO DU TYPE D'E.F. LINEAIRE ASSOCIE 17 : C 18 : C Passage aux nouveaux CHAMELEM par JM CAMPENON le 06/91 19 : C_______________________________________________________________________ 20 : C 21 : IMPLICIT INTEGER(I-N) 22 : IMPLICIT REAL*8(A-H,O-Z) 23 : C 24 : -INC SMCHAML 25 : -INC SMELEME 26 : -INC SMINTE 27 : -INC SMCOORD 28 : -INC CCOPTIO 29 : -INC CCGEOME 30 : C 31 : SEGMENT SHXX 32 : REAL*8 SHPXXX(6,NBBB) 33 : ENDSEGMENT 34 : C 35 : SEGMENT WORK 36 : REAL*8 XE(3,NBPTE1) 37 : ENDSEGMENT 38 : C 39 : MELVAL=IVAFOR 40 : C 41 : MELVA1=IPTVPR 42 : SEGACT MELVA1 43 : NBPTE1=MELVA1.VELCHE(/1) 44 : NEL1 =MELVA1.VELCHE(/2) 45 : C 46 : MINTE=IPTINT 47 : SEGACT MINTE 48 : NBPGAU=POIGAU(/1) 49 : C 50 : MELEME=IPMAIL 51 : SEGACT MELEME 52 : NBPTE1=NUM(/1) 53 : NEL =NUM(/2) 54 : NBBB=NBNNE(IELI) 55 : C 56 : NBPTEL=NBBB 57 : SEGINI SHXX 58 : SEGINI WORK 59 : C 60 : C BOUCLE SUR LES ELEMENTS 61 : C 62 : DO 1 IB=1,NEL 62 : CALL DOXE(XCOOR,IDIM,NBPTE1,NUM,IB,XE) 63 : C 64 : C BOUCLE SUR LES POINTS DE GAUSS 65 : C 66 : IF(IDIM.EQ.3) THEN 67 : C 68 : C CAS TRIDIM 69 : C 70 : DO 10 K=1,NBPGAU 71 : DXDQSI=0.D0 72 : DXDETA=0.D0 73 : DYDQSI=0.D0 74 : DYDETA=0.D0 75 : C 76 : C BOUCLE SUR TOUS LES NOEUDS 77 : C 78 : DO 20 I=1,NBPTE1 79 : DXDQSI=DXDQSI+SHPTOT(2,I,K)*XE(1,I) 80 : DYDQSI=DYDQSI+SHPTOT(2,I,K)*XE(2,I) 81 : DXDETA=DXDETA+SHPTOT(3,I,K)*XE(1,I) 82 : DYDETA=DYDETA+SHPTOT(3,I,K)*XE(2,I) 83 : 20 CONTINUE 84 : DJAC=DXDQSI*DYDETA-DXDETA*DYDQSI 85 : C 86 : KMIN =MIN(K,NBPTE1) 87 : IBMIN=MIN(IB,NEL1) 88 : TJ=POIGAU(K)*MELVA1.VELCHE(KMIN,IBMIN)*DJAC 89 : C 90 : C ON RECUPERE LES FONCTIONS DE FORME LINEAIRES 91 : C 92 : XX=QSIGAU(K) 93 : YY=ETAGAU(K) 94 : ZZ=DZEGAU(K) 94 : CALL SHAPE(XX,YY,ZZ,IELI,SHPXXX,IRT2) 95 : C 96 : C BOUCLE SUR LES SOMMETS UNIQUEMENT 97 : C 98 : DO 30 J=1,NBBB 99 : VELCHE(J,IB)=VELCHE(J,IB)+SHPXXX(1,J)*TJ 100 : 30 CONTINUE 101 : 10 CONTINUE 102 : ELSE IF (IDIM.EQ.2) THEN 103 : C 104 : C CAS BIDIM 105 : C 106 : DO 110 K=1,NBPGAU 107 : DXDQSI=0.D0 108 : DYDQSI=0.D0 109 : R=0.D0 110 : C 111 : C BOUCLE SUR TOUS LES NOEUDS 112 : C 113 : DO 120 I=1,NBPTE1 114 : DXDQSI=DXDQSI+SHPTOT(2,I,K)*XE(1,I) 115 : DYDQSI=DYDQSI+SHPTOT(2,I,K)*XE(2,I) 116 : R=R+SHPTOT(1,I,K)*XE(1,I) 117 : 120 CONTINUE 118 : IF (IFOUR.LT.0) R=1.D0 119 : DJAC=SQRT(DXDQSI*DXDQSI+DYDQSI*DYDQSI) 120 : KMIN=MIN(K,NBPTE1) 121 : IBMIN=MIN(IB,NEL1) 122 : TJ=POIGAU(K)*MELVA1.VELCHE(KMIN,IBMIN)*R*DJAC 123 : C 124 : C ON RECUPERE LES FONCTIONS DE FORME LINEAIRES 125 : C 126 : XX=QSIGAU(K) 127 : YY=ETAGAU(K) 128 : ZZ=0. 128 : CALL SHAPE(XX,YY,ZZ,IELI,SHPXXX,IRT2) 129 : C 130 : C BOUCLE SUR LES SOMMETS UNIQUEMENT 131 : C 132 : DO 130 J=1,NBBB 133 : VELCHE(J,IB)=VELCHE(J,IB)+SHPXXX(1,J)*TJ 134 : 130 CONTINUE 135 : C 136 : 110 CONTINUE 137 : ENDIF 138 : C 139 : 1 CONTINUE 140 : SEGSUP SHXX 141 : SEGSUP WORK 142 : SEGDES MELVA1,MELEME,MINTE 143 : SEGDES MELVAL 144 : RETURN 145 : END 146 : 147 : 148 : 149 : 150 : 151 : 152 : 153 : 154 :
© Cast3M 2003 - All rights reserved.
Disclaimer