Télécharger la plaquette Cast3M


fr en

Télécharger fpeltu.eso

Retour à la liste

Numérotation des lignes : 

fpeltu

  1. C FPELTU    SOURCE    OF166741  25/02/21    21:16:37     12166          
  2. C_______________________________________________________________________
  3. C
  4. C        CALCUL DES FORCES DE PRESSION POUR LES ELEMENTS TUYAU
  5. C
  6. C  ENTREES:
  7. C  ________
  8. C
  9. C     IPTVPR  Pointeur sur un MELVAL contenant les pressions appliquees
  10. C     IVACAR  Pointeur sur un MCHAML de CARACTERISTIQUES
  11. C     IPMAIL  Pointeur sur un MELEME
  12. C     ISOUS   Entier indiquant la zone elementaire traitee
  13. C             (info necessaire dans l'affichage des erreurs 128 et 138)
  14. C
  15. C  SORTIES:
  16. C  ________
  17. C
  18. C     IVAFOR  Pointeur sur un MPTVAL de forces aux noeuds
  19. C_______________________________________________________________________
  20. C
  21.       SUBROUTINE FPELTU(IPTVPR,IVACAR,IPMAIL,ISOUS,IVAFOR)
  22.  
  23.       IMPLICIT INTEGER(I-N)
  24.       IMPLICIT REAL*8 (A-H,O-Z)
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC CCREEL
  29.  
  30. -INC SMCOORD
  31. -INC SMELEME
  32. -INC SMCHAML
  33.  
  34. -INC TMPTVAL
  35.  
  36.       DIMENSION XFORC(12),WORK(12),VECT(3)
  37.       DIMENSION XE(3,2),P(3,3),XX(2),YY(2),ZZ(2)
  38.  
  39.       MELEME=IPMAIL
  40.       NBELEM=NUM(/2)
  41.  
  42. C= BOUCLE SUR LES ELEMENTS
  43.       DO 103 IB=1,NBELEM
  44. C
  45.         CALL DOXE(XCOOR,3,2,NUM,IB,XE)
  46.         DO 105 J=1,2
  47.           XX(J)=XE(1,J)
  48.           YY(J)=XE(2,J)
  49.           ZZ(J)=XE(3,J)
  50.  105    CONTINUE
  51. C
  52.         XLON2=(XX(2)-XX(1))**2+(YY(2)-YY(1))**2+(ZZ(2)-ZZ(1))**2
  53.  
  54.         IF (XLON2.LE.0.D0) THEN
  55.           INTERR(1)=ISOUS
  56.           INTERR(2)=IB
  57.           CALL ERREUR(128)
  58.           RETURN
  59.         ENDIF
  60.  
  61.         CALL ZERO(XFORC,1,12)
  62. C
  63. C       ON CHERCHE LES CARACTERISTIQUES
  64. C
  65.         MPTVAL=IVACAR
  66.         NBCAR=IVAL(/1)
  67. C
  68.         MELVAL=IVAL(1)
  69.         IBMN=MIN(IB,VELCHE(/2))
  70.         EPAI=VELCHE(1,IBMN)
  71. C
  72.         MELVAL=IVAL(2)
  73.         REXT=VELCHE(1,IBMN)
  74. C
  75.         IF (IPTVPR.EQ.0) THEN
  76.           MELVAL=IVAL(3)
  77.         ELSE
  78.           MELVAL=IPTVPR
  79.         ENDIF
  80.         PRES=VELCHE(1,IBMN)
  81. C
  82.         IF (IVAL((NBCAR-3)).NE.0) THEN
  83.           MELVAL=IVAL((NBCAR-3))
  84.           RACO=VELCHE(1,IBMN)
  85.         ELSE
  86.           RACO=0.
  87.         ENDIF
  88. C
  89.         IF (IVAL((NBCAR-2)).NE.0) THEN
  90.           MELVAL=IVAL((NBCAR-2))
  91.           VECT(1)=VELCHE(1,IBMN)
  92.         ELSE
  93.           VECT(1)=0.
  94.         ENDIF
  95. C
  96.         IF (IVAL((NBCAR-1)).NE.0) THEN
  97.           MELVAL=IVAL((NBCAR-1))
  98.           VECT(2)=VELCHE(1,IBMN)
  99.         ELSE
  100.           VECT(2)=0.
  101.         ENDIF
  102. C
  103.         IF (IVAL((NBCAR  )).NE.0) THEN
  104.           MELVAL=IVAL((NBCAR  ))
  105.           VECT(3)=VELCHE(1,IBMN)
  106.         ELSE
  107.           VECT(3)=0.
  108.         ENDIF
  109. C
  110.         RINT=REXT-EPAI
  111.         FL=XPI*PRES*RINT**2
  112.         IF (RACO.NE.0.D0) THEN
  113.           FL=FL/SQRT(1.D0-0.25D0*XLON2/RACO**2)
  114.         ENDIF
  115.         CALL ZERO(WORK,1,12)
  116.         WORK(1)=-FL
  117.         WORK(7)=FL
  118. C
  119.         CALL POUPAS(XX,YY,ZZ,VECT,P,KERRE)
  120.  
  121.         IF (KERRE.NE.0) THEN
  122.           INTERR(1)=ISOUS
  123.           INTERR(2)=IB
  124.           CALL ERREUR(138)
  125.           RETURN
  126.         ENDIF
  127.  
  128.         CALL POUVEC(WORK,XFORC,P,2)
  129. C
  130. C       REMPLISSAGE DU SEGMENT CONTENANT LES FORCES
  131. C
  132.         MPTVAL=IVAFOR
  133.         IE=0
  134.         DO     IGAU=1,2
  135.           DO     ICOMP=1,6
  136.             MELVAL=IVAL(ICOMP)
  137.             IGMN=MIN(IGAU,VELCHE(/1))
  138.             IBMN=MIN(IB  ,VELCHE(/2))
  139.             IE=IE+1
  140.             VELCHE(IGMN,IBMN)=XFORC(IE)
  141.           enddo
  142.         enddo
  143. C
  144.  103  CONTINUE
  145.  
  146.       RETURN
  147.       END
  148.  
  149.  
  150.  

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