C FPMA3D SOURCE CB215821 20/01/21 21:15:11 10505 SUBROUTINE FPMA3D(IPTVPR,IPMAIL,IPTINT,IVAFOR,XP) C C____________________________________________________________________ C C CALCULE LES FORCES DE PRESSIONS SUR LES FACES D ELEMENTS C MASSIFS TRIDIMENSIONNELS C C ENTREES : C --------- C C IPTVPR POINTEUR SUR UN MELVAL CONTENANT LES PRESSIONS APPLIQUEES C 0 SI ON A DONNE UNE PRESSION CONSTANTE C IPMAIL POINTEUR SUR UN OBJET GEOMETRIQUE C IPTINT POINTEUR SUR UN MINTE CONTENANT LES POINTS D INTEGRATION C ACTIF EN ENTREE ET EN SORTIE SANS MODIFICATION C IVAFOR POINTEUR SUR UN MPTVAL ET LES MELVAL CONTENANT LES FORCES C NODALES RESUL C C JACQUELINE BROCHARD AVRIL 85 C C PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 17 09 90 C C______________________________________________________________________ C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C -INC SMCHAML -INC SMELEME -INC SMINTE -INC SMCOORD -INC PPARAM -INC CCOPTIO C SEGMENT MPTVAL INTEGER IPOS(NS),NSOF(NS) INTEGER IVAL(NCOSOU) CHARACTER*16 TYVAL(NCOSOU) ENDSEGMENT C SEGMENT WORK REAL*8 XE(3,NBNN) ENDSEGMENT C * pour daire plaisir a l'optimiseur melva1=iptint IF(IPTVPR.NE.0) THEN MELVA1=IPTVPR SEGACT MELVA1 ENDIF C MINTE=IPTINT NBPGAU=POIGAU(/1) C MELEME=IPMAIL NBNN =NUM(/1) NBELEM=NUM(/2) C SEGINI WORK SEGACT,MCOORD C C BOUCLE SUR LES ELEMENTS C DO 1 IB=1,NBELEM CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) C C BOUCLE SUR LES POINTS DE GAUSS C DO 10 IGAU=1,NBPGAU VNQSI1=0.D0 VNQSI2=0.D0 VNQSI3=0.D0 VNETA1=0.D0 VNETA2=0.D0 VNETA3=0.D0 C T1=0.D0 T2=0.D0 T3=0.D0 C C BOUCLE SUR LES NOEUDS C DO 20 I=1,NBNN VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I) VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I) VNQSI3=VNQSI3+SHPTOT(2,I,IGAU)*XE(3,I) VNETA1=VNETA1+SHPTOT(3,I,IGAU)*XE(1,I) VNETA2=VNETA2+SHPTOT(3,I,IGAU)*XE(2,I) VNETA3=VNETA3+SHPTOT(3,I,IGAU)*XE(3,I) 20 CONTINUE C IF(IPTVPR.NE.0) THEN IGMN=MIN(IGAU,MELVA1.VELCHE(/1)) IBMN=MIN(IB ,MELVA1.VELCHE(/2)) T1=POIGAU(IGAU)*(VNQSI2*VNETA3-VNQSI3*VNETA2)* 1 MELVA1.VELCHE(IGMN,IBMN) T2=POIGAU(IGAU)*(VNQSI3*VNETA1-VNQSI1*VNETA3)* 1 MELVA1.VELCHE(IGMN,IBMN) T3=POIGAU(IGAU)*(VNQSI1*VNETA2-VNQSI2*VNETA1)* 1 MELVA1.VELCHE(IGMN,IBMN) ELSE T1=POIGAU(IGAU)*(VNQSI2*VNETA3-VNQSI3*VNETA2)*XP T2=POIGAU(IGAU)*(VNQSI3*VNETA1-VNQSI1*VNETA3)*XP T3=POIGAU(IGAU)*(VNQSI1*VNETA2-VNQSI2*VNETA1)*XP ENDIF C MPTVAL=IVAFOR MELVAL=IVAL(1) DO J=1,NBNN VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T1 ENDDO MELVAL=IVAL(2) DO J=1,NBNN VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T2 ENDDO MELVAL=IVAL(3) DO J=1,NBNN VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T3 ENDDO 10 CONTINUE 1 CONTINUE SEGDES,MCOORD SEGSUP WORK END