Télécharger la plaquette Cast3M


fr en

Télécharger fde23d.eso

Retour à la liste

Numérotation des lignes : 

fde23d

  1. C FDE23D    SOURCE    OF166741  24/10/21    21:15:13     12042          
  2.  
  3. C_______________________________________________________________________
  4. C
  5. C   CALCULE LES FORCES DE DEBITS SUR LES FACES D ELEMENTS
  6. C   MASSIFS          ( INSPIRE DE FPMA2D ET FPMA3D )
  7. C
  8. C   ENTREES :
  9. C   ---------
  10. C
  11. C    IPTVPR  POINTEUR SUR UN MELVAL CONTENANT LES PRESSIONS APPLIQUEES
  12. C    IPMAIL  POINTEUR SUR UN OBJET GEOMETRIQUE
  13. C    IPTINT  POINTEUR SUR UN MINTE CONTENANT LES POINTS D INTEGRATION
  14. C    IVAFOR  POINTEUR SUR UN MPTVAL ET LES MELVAL CONTENANT LES FORCES
  15. C            NODALES RESUL
  16. C    IELI    NUMERO DU TYPE D'E.F. LINEAIRE ASSOCIE
  17. C_______________________________________________________________________
  18.  
  19.       SUBROUTINE FDE23D(IPTVPR,IPMAIL,IPTINT,IVAFOR,IELI)
  20.  
  21.       IMPLICIT INTEGER(I-N)
  22.       IMPLICIT REAL*8(A-H,O-Z)
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26. -INC CCGEOME
  27.  
  28. -INC SMCHAML
  29. -INC SMELEME
  30. -INC SMINTE
  31. -INC SMCOORD
  32.  
  33.       SEGMENT WORK
  34.          REAL*8 SHPXXX(6,NBBB), XE(3,NBPTEL)
  35.       ENDSEGMENT
  36.  
  37.       MELVAL=IVAFOR
  38.  
  39.       MELVA1=IPTVPR
  40.       NPT1 = MELVA1.VELCHE(/1)
  41.       NEL1 = MELVA1.VELCHE(/2)
  42.  
  43.       MINTE=IPTINT
  44.       NBPGAU=POIGAU(/1)
  45.  
  46.       MELEME = IPMAIL
  47.       NBPTEL = NUM(/1)
  48.       NEL    = NUM(/2)
  49.       NBBB   = NBNNE(IELI)
  50.  
  51.       SEGINI,WORK
  52. C
  53. C     BOUCLE SUR LES ELEMENTS
  54. C
  55.       DO 1 IB=1,NEL
  56.  
  57.          CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IB,XE)
  58.  
  59.          IBMIN = MIN(IB,NEL1)
  60. C
  61. C        BOUCLE SUR LES POINTS DE GAUSS
  62. C
  63.          IF(IDIM.EQ.3) THEN
  64. C
  65. C           CAS TRIDIM
  66. C
  67.             DO 10 K=1,NBPGAU
  68.  
  69.                DXDQSI=0.D0
  70.                DXDETA=0.D0
  71.                DYDQSI=0.D0
  72.                DYDETA=0.D0
  73. C
  74.                DO 20 I=1,NBPTEL
  75.                   DXDQSI=DXDQSI+SHPTOT(2,I,K)*XE(1,I)
  76.                   DYDQSI=DYDQSI+SHPTOT(2,I,K)*XE(2,I)
  77.                   DXDETA=DXDETA+SHPTOT(3,I,K)*XE(1,I)
  78.                   DYDETA=DYDETA+SHPTOT(3,I,K)*XE(2,I)
  79. 20             CONTINUE
  80.  
  81.                DJAC=DXDQSI*DYDETA-DXDETA*DYDQSI
  82. C
  83.                KMIN  = MIN(K ,NPT1)
  84.                TJ=POIGAU(K)*MELVA1.VELCHE(KMIN,IBMIN)*DJAC
  85. C
  86. C              ON RECUPERE LES FONCTIONS DE FORME LINEAIRES
  87. C
  88.                XX=QSIGAU(K)
  89.                YY=ETAGAU(K)
  90.                ZZ=DZEGAU(K)
  91.                CALL SHAPE(XX,YY,ZZ,IELI,SHPXXX,IRT2)
  92. C
  93. C              BOUCLE SUR LES SOMMETS UNIQUEMENT
  94. C
  95.                DO 30 J=1,NBBB
  96.                   VELCHE(J,IB)=VELCHE(J,IB)+SHPXXX(1,J)*TJ
  97.   30           CONTINUE
  98.   10        CONTINUE
  99.          ELSE IF (IDIM.EQ.2) THEN
  100. C
  101. C                      CAS BIDIM
  102. C
  103.             DO 110 K=1,NBPGAU
  104.                DXDQSI=0.D0
  105.                DYDQSI=0.D0
  106.                R=0.D0
  107. C
  108. C              BOUCLE SUR TOUS LES NOEUDS
  109. C
  110.                DO 120 I=1,NBPTEL
  111.                   DXDQSI=DXDQSI+SHPTOT(2,I,K)*XE(1,I)
  112.                   DYDQSI=DYDQSI+SHPTOT(2,I,K)*XE(2,I)
  113.                   R=R+SHPTOT(1,I,K)*XE(1,I)
  114.  120           CONTINUE
  115.                IF (IFOUR.LT.0) R=1.D0
  116.                DJAC=SQRT(DXDQSI*DXDQSI+DYDQSI*DYDQSI)
  117.                KMIN=MIN(K,NPT1)
  118.                TJ=POIGAU(K)*MELVA1.VELCHE(KMIN,IBMIN)*R*DJAC
  119. C
  120. C              ON RECUPERE LES FONCTIONS DE FORME LINEAIRES
  121. C
  122.                XX=QSIGAU(K)
  123.                YY=ETAGAU(K)
  124.                ZZ=0.
  125.                CALL SHAPE(XX,YY,ZZ,IELI,SHPXXX,IRT2)
  126. C
  127. C              BOUCLE SUR LES SOMMETS UNIQUEMENT
  128. C
  129.                DO 130 J=1,NBBB
  130.                   VELCHE(J,IB)=VELCHE(J,IB)+SHPXXX(1,J)*TJ
  131.  130           CONTINUE
  132. C
  133.  110        CONTINUE
  134.          ENDIF
  135. C
  136.    1  CONTINUE
  137.  
  138.       SEGSUP,WORK
  139.  
  140.       RETURN
  141.       END
  142.  
  143.  
  144.  
  145.  

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