Sources Esope | Cast3M

fpco2d
C FPCO2D    SOURCE    OF166741  25/02/21    21:16:32     12166          
      SUBROUTINE FPCO2D(IPTVPR,IPMAIL,IVAFOR,IVACAR)
*____________________________________________________________________
*
*   CALCULE LES FORCES DE PRESSIONS SUR LES FACES D ELEMENTS
*   COQUES BIDIMENSIONNELS
*
*
*   ENTREES :
*   ---------
*
*    IPTVPR  POINTEUR SUR UN MELVAL CONTENANT LES PRESSIONS APPLIQUEES
*            (actif)
*    IPMAIL  POINTEUR SUR UN OBJET GEOMETRIQUE (actif)
*    IVAFOR  POINTEUR SUR UN MPTVAL ET UN MELVAL DEVANT CONTENIR LES
*            FORCES NODALES RESULTANTES
*
*
*      JACQUELINE BROCHARD  AVRIL 85
*      PASSAGE AUX NOUVEAU CHAMELEM PAR JM CAMPENON LE 12 09 90
*      REPRISE MILL AVRIL 91  ON SUPPOSE QUE LES PRESSIONS SONT
*                             DONNEES AUX NOEUDS
*____________________________________________________________________
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
 
-INC SMCHAML
-INC SMELEME
-INC SMCOORD
 
-INC TMPTVAL
 
      DIMENSION XE(3,3)
*
      MELVA1=IPTVPR
*
      MELEME=IPMAIL
      SEGACT MELEME
      NBELEM=NUM(/2)
      IGMN=MIN(2,MELVA1.VELCHE(/1))
      DIM3=1.D0
*
*     BOUCLE SUR LES ELEMENTS
*
      DO 1 IB=1,NBELEM
C
C   RECUPERATION DE L'EPAISSEUR
C
         IF (IFOUR.EQ.-2) THEN
            MPTVAL=IVACAR
            IF (IVACAR.NE.0) THEN
C
C             DIM3 EST LA DERNIERE COMPOSANTE DE IVACAR
C             (CF FPCOQU ET BSIGMP)
C
               MELVAL=IVAL(IVAL(/1))
               IF (MELVAL.NE.0) THEN
                  IBMN=MIN(IB,VELCHE(/2))
                  DIM3=VELCHE(IGMN,IBMN)
               ENDIF
            ENDIF
         ENDIF
*
         CALL DOXE(XCOOR,IDIM,2,NUM,IB,XE)
         IF (IDIM.EQ.3) THEN
           R1=XE(1,1)
           R2=XE(1,2)
           Z1=XE(3,1)
           Z2=XE(3,2)
         ELSE
         R1=XE(1,1)
         R2=XE(1,2)
         Z1=XE(2,1)
         Z2=XE(2,2)
         ENDIF
*
         D2=(R2-R1)*(R2-R1)+(Z2-Z1)*(Z2-Z1)
         D=SQRT(D2)
         UNSD=1.D0/D
         A=(R2-R1)*UNSD
         B=(Z2-Z1)*UNSD
         IF(IFOUR.LT.0) THEN
            R1=1.D0
            R2=1.D0
         ELSEIF(IFOUR.EQ.0.OR.(IFOUR.EQ.1.AND.
     +           NIFOUR.EQ.0)) THEN
            R1=2*XPI*R1
            R2=2*XPI*R2
         ELSEIF(IFOUR.EQ.1.AND.NIFOUR.NE.0) THEN
            R1=XPI*R1
            R2=XPI*R2
         ENDIF
         IF (IFOUR.EQ.-2) THEN
            R1=R1*DIM3
            R2=R2*DIM3
         ENDIF
         IF(IFOUR.LE.0) IFO=0
         IF(IFOUR.EQ.1) IFO=1
*
         IBMN=MIN(IB,MELVA1.VELCHE(/2))
         P1=MELVA1.VELCHE(1,IBMN)
         P2=MELVA1.VELCHE(IGMN,IBMN)
*
         PA=P1*R1
         PB=P1*R2+P2*R1-2.D0*P1*R1
         PC=(P2-P1)*(R2-R1)
*
         FP1=D*(PA*0.5D0+PB*0.15D0+PC/15.D0)
         XO1=D2*(PA/12.D0+PB/30.D0+PC/60.D0)
         FP2=D*(PA*0.5D0+PB*0.35D0+PC*4.D0/15.D0)
         XO2=-D2*(PA/12.D0+PB/20.D0+PC/30.D0)
*
         MPTVAL=IVAFOR
         MELVAL=IVAL(1)
         VELCHE(1,IB)=-B*FP1
         VELCHE(2,IB)=-B*FP2
*
         MELVAL=IVAL(2)
         VELCHE(1,IB)=A*FP1
         VELCHE(2,IB)=A*FP2
*
         MELVAL=IVAL(3+IFO)
         VELCHE(1,IB)=XO1
         VELCHE(2,IB)=XO2
*
 1    CONTINUE
      RETURN
      END