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    BP208322  16/11/18    21:17:02     9177           
  2.       SUBROUTINE FDE23D(IPTVPR,IPMAIL,IPTINT,IVAFOR,IELI)
  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. C   Passage aux nouveaux CHAMELEM par JM CAMPENON le 06/91
  19. C_______________________________________________________________________
  20. C
  21.       IMPLICIT INTEGER(I-N)
  22.       IMPLICIT REAL*8(A-H,O-Z)
  23. C
  24. -INC SMCHAML
  25. -INC SMELEME
  26. -INC SMINTE
  27. -INC SMCOORD
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC CCGEOME
  32. C
  33.       SEGMENT SHXX
  34.          REAL*8 SHPXXX(6,NBBB)
  35.       ENDSEGMENT
  36. C
  37.       SEGMENT WORK
  38.          REAL*8 XE(3,NBPTE1)
  39.       ENDSEGMENT
  40. C
  41.       MELVAL=IVAFOR
  42. C
  43.       MELVA1=IPTVPR
  44.       SEGACT MELVA1
  45.       NBPTE1=MELVA1.VELCHE(/1)
  46.       NEL1  =MELVA1.VELCHE(/2)
  47. C
  48.       MINTE=IPTINT
  49.       SEGACT MINTE
  50.       NBPGAU=POIGAU(/1)
  51. C
  52.       MELEME=IPMAIL
  53.       SEGACT MELEME
  54.       NBPTE1=NUM(/1)
  55.       NEL   =NUM(/2)
  56.       NBBB=NBNNE(IELI)
  57. C
  58.       NBPTEL=NBBB
  59.       SEGINI SHXX
  60.       SEGINI WORK
  61. C
  62. C     BOUCLE SUR LES ELEMENTS
  63. C
  64.       DO 1 IB=1,NEL
  65.          CALL DOXE(XCOOR,IDIM,NBPTE1,NUM,IB,XE)
  66. C
  67. C        BOUCLE SUR LES POINTS DE GAUSS
  68. C
  69.          IF(IDIM.EQ.3) THEN
  70. C
  71. C           CAS TRIDIM
  72. C
  73.             DO 10 K=1,NBPGAU
  74.                DXDQSI=0.D0
  75.                DXDETA=0.D0
  76.                DYDQSI=0.D0
  77.                DYDETA=0.D0
  78. C
  79. C              BOUCLE SUR TOUS LES NOEUDS
  80. C
  81.                DO 20 I=1,NBPTE1
  82.                   DXDQSI=DXDQSI+SHPTOT(2,I,K)*XE(1,I)
  83.                   DYDQSI=DYDQSI+SHPTOT(2,I,K)*XE(2,I)
  84.                   DXDETA=DXDETA+SHPTOT(3,I,K)*XE(1,I)
  85.                   DYDETA=DYDETA+SHPTOT(3,I,K)*XE(2,I)
  86. 20             CONTINUE
  87.                DJAC=DXDQSI*DYDETA-DXDETA*DYDQSI
  88. C
  89.                KMIN =MIN(K,NBPTE1)
  90.                IBMIN=MIN(IB,NEL1)
  91.                TJ=POIGAU(K)*MELVA1.VELCHE(KMIN,IBMIN)*DJAC
  92. C
  93. C              ON RECUPERE LES FONCTIONS DE FORME LINEAIRES
  94. C
  95.                XX=QSIGAU(K)
  96.                YY=ETAGAU(K)
  97.                ZZ=DZEGAU(K)
  98.                CALL SHAPE(XX,YY,ZZ,IELI,SHPXXX,IRT2)
  99. C
  100. C              BOUCLE SUR LES SOMMETS UNIQUEMENT
  101. C
  102.                DO 30 J=1,NBBB
  103.                   VELCHE(J,IB)=VELCHE(J,IB)+SHPXXX(1,J)*TJ
  104.   30           CONTINUE
  105.   10        CONTINUE
  106.          ELSE IF (IDIM.EQ.2) THEN
  107. C
  108. C                      CAS BIDIM
  109. C
  110.             DO 110 K=1,NBPGAU
  111.                DXDQSI=0.D0
  112.                DYDQSI=0.D0
  113.                R=0.D0
  114. C
  115. C              BOUCLE SUR TOUS LES NOEUDS
  116. C
  117.                DO 120 I=1,NBPTE1
  118.                   DXDQSI=DXDQSI+SHPTOT(2,I,K)*XE(1,I)
  119.                   DYDQSI=DYDQSI+SHPTOT(2,I,K)*XE(2,I)
  120.                   R=R+SHPTOT(1,I,K)*XE(1,I)
  121.  120           CONTINUE
  122.                IF (IFOUR.LT.0) R=1.D0
  123.                DJAC=SQRT(DXDQSI*DXDQSI+DYDQSI*DYDQSI)
  124.                KMIN=MIN(K,NBPTE1)
  125.                IBMIN=MIN(IB,NEL1)
  126.                TJ=POIGAU(K)*MELVA1.VELCHE(KMIN,IBMIN)*R*DJAC
  127. C
  128. C              ON RECUPERE LES FONCTIONS DE FORME LINEAIRES
  129. C
  130.                XX=QSIGAU(K)
  131.                YY=ETAGAU(K)
  132.                ZZ=0.
  133.                CALL SHAPE(XX,YY,ZZ,IELI,SHPXXX,IRT2)
  134. C
  135. C              BOUCLE SUR LES SOMMETS UNIQUEMENT
  136. C
  137.                DO 130 J=1,NBBB
  138.                   VELCHE(J,IB)=VELCHE(J,IB)+SHPXXX(1,J)*TJ
  139.  130           CONTINUE
  140. C
  141.  110        CONTINUE
  142.          ENDIF
  143. C
  144.    1  CONTINUE
  145.       SEGSUP SHXX
  146.       SEGSUP WORK
  147.       SEGDES MELVA1,MELEME,MINTE
  148.       SEGDES MELVAL
  149.       RETURN
  150.       END
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  
  161.  
  162.  

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