Sources Esope | Cast3M

fsco2d
C FSCO2D    SOURCE    OF166741  25/02/21    21:16:59     12166          
*
      SUBROUTINE FSCO2D(IPT,IPMAIL,IPVECT,V,IVAFOR,IVACAR)
*
*_______________________________________________________________________
*
*   CALCULE LES FORCES SURFACIQUES SUR LES FACES D ELEMENTS
*   COQUES BIDIMENSIONNELS
*
*   ENTREES :
*   ---------
*
*    IPT     TABLEAU DE POINTEUR SUR UN MPTVAL CONTENANT LES FORCES
*            APPLIQUEES
*            0 SI ON A DONNE UNE FORCE CONSTANTE
*    IPMAIL  POINTEUR SUR UN OBJET GEOMETRIQUE
*    IPVECT   POINTEUR SUR LE VECTEUR REPRESENTANT LA FORCE
*    V        VECTEUR REPRESENTANT LA FORCE
*    IVAFOR  POINTEUR SUR UN MPTVAL ET UN MELVAL DEVANT CONTENIR LES
*            FORCES NODALES RESULTANTES
*
*_______________________________________________________________________
 
      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 IPT(*),V(*)
      DIMENSION XE(3,2)
*
      PARAMETER ( X2Pi = 6.283185307179586476925286766559D0 )
*
      MELVA1 = IPT(1)
      MELVA2 = IPT(2)
      IF (IPVECT.EQ.0) THEN
        F11I = XZero
        F12I = XZero
        F21I = XZero
        F22I = XZero
        IF (MELVA1.NE.0) THEN
          SEGACT,MELVA1
          IGM1 = MIN(2,MELVA1.VELCHE(/1))
          IBM1 = MELVA1.VELCHE(/2)
        ENDIF
        IF (MELVA2.NE.0) THEN
          SEGACT,MELVA2
          IGM2 = MIN(2,MELVA2.VELCHE(/1))
          IBM2 = MELVA2.VELCHE(/2)
        ENDIF
      ELSE
        F11I = V(1)
        F12I = V(2)
        F21I = V(1)
        F22I = V(2)
      ENDIF
 
      MELEME=IPMAIL
C*      SEGACT,MELEME          &lt;- ACTIF EN E/S (NON MODIFIE)
C*      NBNN=NUM(/1)
      NBELEM=NUM(/2)
C
C RECUPERATION DE L'EPAISSEUR (CONTRAINTES PLANES) :
C
      DIM3 = 1.D0
      MELVA3 = 0
      IF (IVACAR.NE.0 .AND. IFOUR.EQ.-2) THEN
        MPTVAL = IVACAR
        MELVA3 = IVAL(1)
        IF (MELVA3.NE.0) THEN
          IGM3 = MELVA3.VELCHE(/1)
          IBM3 = MELVA3.VELCHE(/2)
        ENDIF
      ENDIF
 
      IF (IFOUR.LE.0) THEN
        IFO = 0
      ELSE IF (IFOUR.EQ.1)THEN
        IFO = 1
      ENDIF
*
      MPTVAL = IVAFOR
*
*     BOUCLE SUR LES ELEMENTS
*
      DO 1 IB = 1, NBELEM
C
C   RECUPERATION DE L'EPAISSEUR SI DEFINIE
C
        IF (MELVA3.NE.0) THEN
          IBMN = MIN(IB,IBM3)
*OF Valeur constante par element ?
          DIM3 = MELVA3.VELCHE(IGM3,IBMN)
        ENDIF
*
        CALL DOXE(XCOOR,IDIM,2,NUM,IB,XE)
 
        R1 = XE(1,1)
        R2 = XE(1,2)
 
        A = R2 - R1
        B = XE(2,2) - XE(2,1)
        D2 = A*A + B*B
        D = SQRT(D2)
        UNSD = 1.D0/D
        A = A * UNSD
        B = B * UNSD
 
        IF (IFOUR.LT.0) THEN
          IF (IFOUR.EQ.-2) THEN
            R1 = DIM3
            R2 = DIM3
          ELSE
            R1 = 1.D0
            R2 = 1.D0
          ENDIF
        ELSE IF (IFOUR.EQ.0) THEN
           R1 = X2Pi * R1
           R2 = X2Pi * R2
C*      ELSE IF (IFOUR.EQ.1) THEN
        ELSE
          IF (NIFOUR.EQ.0) THEN
            R1 = X2Pi * R1
            R2 = X2Pi * R2
          ELSE
            R1 = XPI * R1
            R2 = XPI * R2
          ENDIF
        ENDIF
*
        IF (IPVECT.EQ.0) THEN
          IF (MELVA1.NE.0) THEN
            IBMN = MIN(IB,IBM1)
            F11I = MELVA1.VELCHE(1,IBMN)
            F21I = MELVA1.VELCHE(IGM1,IBMN)
          ENDIF
          IF (MELVA2.NE.0) THEN
            IBMN = MIN(IB,IBM2)
            F12I = MELVA2.VELCHE(1,IBMN)
            F22I = MELVA2.VELCHE(IGM2,IBMN)
          ENDIF
        ENDIF
*
*        chgt repère du vecteur F: global -> local
*
        F11 =  A*F11I + B*F12I
        F12 = -B*F11I + A*F12I
        F21 =  A*F21I + B*F22I
        F22 = -B*F21I + A*F22I
*
        FA = F12*R1
        FB = F12*R2 + F22*R1 - 2.D0*F12*R1
        FC = (F22-F12)*(R2-R1)
*
        XO1  = D2 * (FA/12.D0+FB/30.D0+FC/60.D0)
        XO2  =-D2 * (FA/12.D0+FB/20.D0+FC/30.D0)
*
        FP12 =  D * (FA*0.5D0+FB*0.15D0+FC/15.D0)
        FP22 =  D * (FA*0.5D0+FB*0.35D0+FC*4.D0/15.D0)
*
        IF (IFOUR.EQ.0) THEN
          FD=F11*R1
          FE=F21*R2
          FF=F21*R1 + F11*R2 + FE
          FG=F21*R1 + F11*R2 + FD
          FP11=D*(FD/4.D0 + FF/12.D0)
          FP21=D*(FE/4.D0 + FG/12.D0)
        ELSE
          FP11=D*(F11/3.D0 + F21/6.D0)
          FP21=D*(F21/3.D0 + F11/6.D0)
        ENDIF
*
        MELVAL = IVAL(1)
        VELCHE(1,IB) = -B*FP12 + A*FP11
        VELCHE(2,IB) = -B*FP22 + A*FP21
*
        MELVAL = IVAL(2)
        VELCHE(1,IB) = A*FP12 + B*FP11
        VELCHE(2,IB) = A*FP22 + B*FP21
*
        MELVAL = IVAL(3+IFO)
        VELCHE(1,IB) = XO1
        VELCHE(2,IB) = XO2
*
 1    CONTINUE
 
      IF (IPVECT.EQ.0) THEN
        IF (MELVA1.NE.0) SEGDES,MELVA1
        IF (MELVA2.NE.0) SEGDES,MELVA2
      ENDIF
C*      SEGDES,MELEME          &lt;- ACTIF EN E/S (NON MODIFIE)
 
      RETURN
      END