Télécharger la plaquette Cast3M


fr en

Télécharger fpco3d.eso

Retour à la liste

Numérotation des lignes : 

fpco3d

  1. C FPCO3D    SOURCE    OF166741  25/02/21    21:16:33     12166          
  2.       SUBROUTINE FPCO3D(IPTVPR,IPMAIL,IVAFOR)
  3. C____________________________________________________________________
  4. C
  5. C   CALCULE LES FORCES DE PRESSIONS SUR LES COQUES 3D
  6. C
  7. C
  8. C   ENTREES :
  9. C   ---------
  10. C
  11. C    IPTVPR   MELVAL CONTENANT LES PRESSIONS APPLIQUEES (ACTIF)
  12. C    IPMAIL   OBJET GEOMETRIQUE (ACTIF)
  13. C    IVAFOR   POINTEUR SUR UN MPTVAL ET MELVALS ASSOCIEES AUX FORCES
  14. C             NODALE RESULTANTES
  15. C
  16. C      JACQUELINE BROCHARD  AVRIL 85
  17. C      PASSAGE AUX NOUVEAU CHAMELEM PAR JM CAMPENON LE 21 09 90
  18. C
  19. C____________________________________________________________________
  20. C
  21.       IMPLICIT INTEGER(I-N)
  22.       IMPLICIT REAL*8(A-H,O-Z)
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26.  
  27. -INC SMCHAML
  28. -INC SMELEME
  29. -INC SMCOORD
  30.  
  31. -INC TMPTVAL
  32.  
  33.       DIMENSION XE(3,3),XEL(3,3),BPSS(3,3),BB(9),FT(18),F(6)
  34.       DIMENSION XX(3),YY(3)
  35. C
  36.       DATA XX/0.5D0,0.5D0,0.0D0/
  37.       DATA YY/0.0D0,0.5D0,0.5D0/
  38.       DATA UNTIER/.33333333333333333D0/
  39. C
  40.       MELVA1=IPTVPR
  41.       IGMN=MIN(3,MELVA1.VELCHE(/1))
  42. C
  43.       MELEME=IPMAIL
  44.       NBELEM=NUM(/2)
  45. C
  46. C     BOUCLE SUR LES ELEMENTS
  47. C
  48.       DO 1000 IB=1,NBELEM
  49.          IBMN=MIN(IB,MELVA1.VELCHE(/2))
  50.          IF (IGMN.EQ.1) THEN
  51. *
  52. *           Champ constant
  53. *
  54.             P=MELVA1.VELCHE(1,IBMN)
  55.          ELSE
  56. *
  57. *           P moyen sur l'element
  58. *
  59.             P=0.D0
  60.             DO 11 IGAU=1,3
  61.                P=MELVA1.VELCHE(IGAU,IBMN)+P
  62.  11         CONTINUE
  63.             P=P/3
  64.          ENDIF
  65.          CALL DOXE(XCOOR,IDIM,3,NUM,IB,XE)
  66. C
  67. C        MATRICE DE PASSAGE
  68. C
  69.          CALL VPAST(XE,BPSS)
  70. C
  71. C        COORDONNEES LOCALES
  72. C
  73.          CALL VCORLC(XE,XEL,BPSS)
  74. C
  75. C        MISE A 0 DU VECTEUR FORCE
  76. C
  77.          DO 100 I=1,18
  78.  100     FT(I)=0.D0
  79.          X21=XEL(1,2)-XEL(1,1)
  80.          Y31=XEL(2,3)-XEL(2,1)
  81.          SURF=X21*Y31*.5D0
  82. C
  83. C        INTEGRATION NUMERIQUE : IGAU NUMERO DU POINT DE GAUSS
  84. C                                IA NUMERO D UN NOEUD
  85. C
  86.          DO 200 IGAU=1,3
  87.             CALL MFDKT(XX(IGAU),YY(IGAU),XEL,BB)
  88.             DO 210 IA=1,3
  89.                IP=(IA-1)*6+2
  90.                IK=(IA-1)*3
  91.                DO 220 ID=1,3
  92.                   FT(IP+ID)=FT(IP+ID)+UNTIER*BB(IK+ID)
  93.   220          CONTINUE
  94.   210       CONTINUE
  95.   200    CONTINUE
  96. C
  97. C        MULTIPLICATION PAR P*SURF
  98. C
  99.          DO 300 I=1,18
  100.             FT(I)=FT(I)*SURF*P
  101.   300    CONTINUE
  102. C
  103. C        CHANGEMENT DE REPERE
  104. C
  105.          DO 400 I=1,3
  106.             KP=6*(I-1)
  107.             MP=KP+3
  108.             DO 401 II=1,6
  109.  401        F(II)=0.D0
  110.             DO 402 J=1,3
  111.                LP=J
  112.                NP=LP+3
  113.                DO 403   JP=1,3
  114.                   F(LP)=F(LP)+BPSS(JP,J)*FT(JP+KP)
  115.                   F(NP)=F(NP)+BPSS(JP,J)*FT(JP+MP)
  116.  403           CONTINUE
  117.  402        CONTINUE
  118.             MPTVAL=IVAFOR
  119.             DO 410 K=1,6
  120.                MELVAL=IVAL(K)
  121.                VELCHE(I,IB)=F(K)
  122.   410       CONTINUE
  123.   400    CONTINUE
  124.  1000 CONTINUE
  125.  
  126.       RETURN
  127.       END
  128.  
  129.  
  130.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales