Esope source files

   1 : C FPCO2D    SOURCE    PV        09/03/12    21:23:01     6325           
   2 :       SUBROUTINE FPCO2D(IPTVPR,IPMAIL,IVAFOR,IVACAR)
   3 : *____________________________________________________________________
   4 : *     
   5 : *   CALCULE LES FORCES DE PRESSIONS SUR LES FACES D ELEMENTS
   6 : *   COQUES BIDIMENSIONNELS
   7 : *     
   8 : *     
   9 : *   ENTREES :
  10 : *   ---------
  11 : *     
  12 : *    IPTVPR  POINTEUR SUR UN MELVAL CONTENANT LES PRESSIONS APPLIQUEES
  13 : *            (actif)
  14 : *    IPMAIL  POINTEUR SUR UN OBJET GEOMETRIQUE (actif)
  15 : *    IVAFOR  POINTEUR SUR UN MPTVAL ET UN MELVAL DEVANT CONTENIR LES
  16 : *            FORCES NODALES RESULTANTES
  17 : *     
  18 : *     
  19 : *      JACQUELINE BROCHARD  AVRIL 85
  20 : *      PASSAGE AUX NOUVEAU CHAMELEM PAR JM CAMPENON LE 12 09 90
  21 : *      REPRISE MILL AVRIL 91  ON SUPPOSE QUE LES PRESSIONS SONT
  22 : *                             DONNEES AUX NOEUDS
  23 : *____________________________________________________________________
  24 :       IMPLICIT INTEGER(I-N)
  25 :       IMPLICIT REAL*8(A-H,O-Z)
  26 : *     
  27 : -INC CCREEL
  28 : -INC SMCHAML
  29 : -INC SMELEME
  30 : -INC SMCOORD
  31 : -INC CCOPTIO
  32 : *     
  33 :       SEGMENT MPTVAL
  34 :       INTEGER IPOS(NS)    ,NSOF(NS)
  35 :       INTEGER      IVAL(NCOSOU)
  36 :       CHARACTER*16 TYVAL(NCOSOU)
  37 :       ENDSEGMENT
  38 : *     
  39 :       DIMENSION XE(3,3)
  40 : *     
  41 :       MELVA1=IPTVPR
  42 : *     
  43 :       MELEME=IPMAIL
  44 :       SEGACT MELEME
  45 :       NBELEM=NUM(/2)
  46 :       IGMN=MIN(2,MELVA1.VELCHE(/1))
  47 :       DIM3=1.D0
  48 : *     
  49 : *     BOUCLE SUR LES ELEMENTS
  50 : *     
  51 :       DO 1 IB=1,NBELEM
  52 : C     
  53 : C   RECUPERATION DE L'EPAISSEUR
  54 : C     
  55 :          IF (IFOUR.EQ.-2) THEN
  56 :             MPTVAL=IVACAR
  57 :             IF (IVACAR.NE.0) THEN
  58 :                MELVAL=IVAL(1)
  59 :                IF (MELVAL.NE.0) THEN
  60 :                   IBMN=MIN(IB,VELCHE(/2))
  61 :                   DIM3=VELCHE(IGMN,IBMN)
  62 :                ELSE
  63 :                   DIM3=1.D0
  64 :                ENDIF
  65 :             ENDIF
  66 :          ENDIF
  67 : *     
  67 :          CALL DOXE(XCOOR,IDIM,2,NUM,IB,XE)
  68 :          R1=XE(1,1)
  69 :          R2=XE(1,2)
  70 :          Z1=XE(2,1)
  71 :          Z2=XE(2,2)
  72 : *     
  73 :          D2=(R2-R1)*(R2-R1)+(Z2-Z1)*(Z2-Z1)
  74 :          D=SQRT(D2)
  75 :          UNSD=1.D0/D
  76 :          A=(R2-R1)*UNSD
  77 :          B=(Z2-Z1)*UNSD
  78 :          IF(IFOUR.LT.0) THEN
  79 :             R1=1.D0
  80 :             R2=1.D0
  81 :          ELSEIF(IFOUR.EQ.0.OR.(IFOUR.EQ.1.AND.
  82 :      +           NIFOUR.EQ.0)) THEN
  83 :             R1=2*XPI*R1
  84 :             R2=2*XPI*R2
  85 :          ELSEIF(IFOUR.EQ.1.AND.NIFOUR.NE.0) THEN
  86 :             R1=XPI*R1
  87 :             R2=XPI*R2
  88 :          ENDIF
  89 :          IF (IFOUR.EQ.-2) THEN
  90 :             R1=R1*DIM3
  91 :             R2=R2*DIM3
  92 :          ENDIF
  93 :          IF(IFOUR.LE.0) IFO=0
  94 :          IF(IFOUR.EQ.1) IFO=1
  95 : *     
  96 :          IBMN=MIN(IB,MELVA1.VELCHE(/2))
  97 :          P1=MELVA1.VELCHE(1,IBMN)
  98 :          P2=MELVA1.VELCHE(IGMN,IBMN)
  99 : *     
 100 :          PA=P1*R1
 101 :          PB=P1*R2+P2*R1-2.D0*P1*R1
 102 :          PC=(P2-P1)*(R2-R1)
 103 : *     
 104 :          FP1=D*(PA*0.5D0+PB*0.15D0+PC/15.D0)
 105 :          XO1=D2*(PA/12.D0+PB/30.D0+PC/60.D0)
 106 :          FP2=D*(PA*0.5D0+PB*0.35D0+PC*4.D0/15.D0)
 107 :          XO2=-D2*(PA/12.D0+PB/20.D0+PC/30.D0)
 108 : *     
 109 :          MPTVAL=IVAFOR
 110 :          MELVAL=IVAL(1)
 111 :          VELCHE(1,IB)=-B*FP1
 112 :          VELCHE(2,IB)=-B*FP2
 113 : *     
 114 :          MELVAL=IVAL(2)
 115 :          VELCHE(1,IB)=A*FP1
 116 :          VELCHE(2,IB)=A*FP2
 117 : *     
 118 :          MELVAL=IVAL(3+IFO)
 119 :          VELCHE(1,IB)=XO1
 120 :          VELCHE(2,IB)=XO2
 121 : *     
 122 :  1    CONTINUE
 123 :       RETURN
 124 :       END
 125 : 
 126 : 
 127 : 
 128 : 
 129 :  
 130 :  
 131 :  
 132 :  
 133 :