1 : C FPMA3D SOURCE FANDEUR 10/08/31 21:17:13 6734 2 : SUBROUTINE FPMA3D(IPTVPR,IPMAIL,IPTINT,IVAFOR,XP) 3 : C 4 : C____________________________________________________________________ 5 : C 6 : C CALCULE LES FORCES DE PRESSIONS SUR LES FACES D ELEMENTS 7 : C MASSIFS TRIDIMENSIONNELS 8 : C 9 : C ENTREES : 10 : C --------- 11 : C 12 : C IPTVPR POINTEUR SUR UN MELVAL CONTENANT LES PRESSIONS APPLIQUEES 13 : C 0 SI ON A DONNE UNE PRESSION CONSTANTE 14 : C IPMAIL POINTEUR SUR UN OBJET GEOMETRIQUE 15 : C IPTINT POINTEUR SUR UN MINTE CONTENANT LES POINTS D INTEGRATION 16 : C ACTIF EN ENTREE ET EN SORTIE SANS MODIFICATION 17 : C IVAFOR POINTEUR SUR UN MPTVAL ET LES MELVAL CONTENANT LES FORCES 18 : C NODALES RESUL 19 : C 20 : C JACQUELINE BROCHARD AVRIL 85 21 : C 22 : C PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 17 09 90 23 : C 24 : C______________________________________________________________________ 25 : C 26 : IMPLICIT INTEGER(I-N) 27 : IMPLICIT REAL*8(A-H,O-Z) 28 : C 29 : -INC SMCHAML 30 : -INC SMELEME 31 : -INC SMINTE 32 : -INC SMCOORD 33 : -INC CCOPTIO 34 : C 35 : SEGMENT MPTVAL 36 : INTEGER IPOS(NS) ,NSOF(NS) 37 : INTEGER IVAL(NCOSOU) 38 : CHARACTER*16 TYVAL(NCOSOU) 39 : ENDSEGMENT 40 : C 41 : SEGMENT WORK 42 : REAL*8 XE(3,NBNN) 43 : ENDSEGMENT 44 : C 45 : * pour daire plaisir a l'optimiseur 46 : melva1=iptint 47 : IF(IPTVPR.NE.0) THEN 48 : MELVA1=IPTVPR 49 : SEGACT MELVA1 50 : ENDIF 51 : C 52 : MINTE=IPTINT 53 : C* SEGACT MINTE <- ACTIF EN E/S 54 : NBPGAU=POIGAU(/1) 55 : C 56 : MELEME=IPMAIL 57 : SEGACT MELEME 58 : NBNN =NUM(/1) 59 : NBELEM=NUM(/2) 60 : C 61 : SEGINI WORK 62 : C 63 : C BOUCLE SUR LES ELEMENTS 64 : C 65 : DO 1 IB=1,NBELEM 65 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 66 : C 67 : C BOUCLE SUR LES POINTS DE GAUSS 68 : C 69 : DO 10 IGAU=1,NBPGAU 70 : VNQSI1=0.D0 71 : VNQSI2=0.D0 72 : VNQSI3=0.D0 73 : VNETA1=0.D0 74 : VNETA2=0.D0 75 : VNETA3=0.D0 76 : C 77 : T1=0.D0 78 : T2=0.D0 79 : T3=0.D0 80 : C 81 : C BOUCLE SUR LES NOEUDS 82 : C 83 : DO 20 I=1,NBNN 84 : VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I) 85 : VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I) 86 : VNQSI3=VNQSI3+SHPTOT(2,I,IGAU)*XE(3,I) 87 : VNETA1=VNETA1+SHPTOT(3,I,IGAU)*XE(1,I) 88 : VNETA2=VNETA2+SHPTOT(3,I,IGAU)*XE(2,I) 89 : VNETA3=VNETA3+SHPTOT(3,I,IGAU)*XE(3,I) 90 : 20 CONTINUE 91 : C 92 : IF(IPTVPR.NE.0) THEN 93 : IGMN=MIN(IGAU,MELVA1.VELCHE(/1)) 94 : IBMN=MIN(IB ,MELVA1.VELCHE(/2)) 95 : T1=POIGAU(IGAU)*(VNQSI2*VNETA3-VNQSI3*VNETA2)* 96 : 1 MELVA1.VELCHE(IGMN,IBMN) 97 : T2=POIGAU(IGAU)*(VNQSI3*VNETA1-VNQSI1*VNETA3)* 98 : 1 MELVA1.VELCHE(IGMN,IBMN) 99 : T3=POIGAU(IGAU)*(VNQSI1*VNETA2-VNQSI2*VNETA1)* 100 : 1 MELVA1.VELCHE(IGMN,IBMN) 101 : ELSE 102 : T1=POIGAU(IGAU)*(VNQSI2*VNETA3-VNQSI3*VNETA2)*XP 103 : T2=POIGAU(IGAU)*(VNQSI3*VNETA1-VNQSI1*VNETA3)*XP 104 : T3=POIGAU(IGAU)*(VNQSI1*VNETA2-VNQSI2*VNETA1)*XP 105 : ENDIF 106 : C 107 : MPTVAL=IVAFOR 108 : DO 30 J=1,NBNN 109 : MELVAL=IVAL(1) 110 : VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T1 111 : MELVAL=IVAL(2) 112 : VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T2 113 : MELVAL=IVAL(3) 114 : VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T3 115 : 30 CONTINUE 116 : 10 CONTINUE 117 : 1 CONTINUE 118 : 119 : SEGSUP WORK 120 : IF(IPTVPR.NE.0) SEGDES MELVA1 121 : SEGDES MELEME 122 : C* SEGDES,MINTE <- ACTIF EN E/S 123 : 124 : RETURN 125 : END 126 : 127 :
© Cast3M 2003 - All rights reserved.
Disclaimer