Télécharger la plaquette Cast3M


fr en

Télécharger fpma1d.eso

Retour à la liste

Numérotation des lignes : 

fpma1d

  1. C FPMA1D    SOURCE    FANDEUR   10/08/31    21:17:10     6734
  2.  
  3. C=======================================================================
  4. C=  Calcul des forces de pressions s'exercant sur les faces d elements =
  5. C=  massifs unidimensionnels (1D)                                      =
  6. C=                                                                     =
  7. C=  IPTVPR  Pointeur sur un MELVAL contenant les pressions appliquees  =
  8. C=          =0 si on a donne une valeur constante                      =
  9. C=  IPMAIL  Pointeur sur un MELEME de l'ENVELOPPE                      =
  10. C=  IPTINT  Pointeur sur un MINTE des caracteristiques d'integration   =
  11. C=          (ACTIF en ENTREE et en SORTIE sans modification)           =
  12. C=  IVAFOR  Pointeur sur un MPTVAL (MELVAL) contenant les forces       =
  13. C=          nodales equivalentes                                       =
  14. C=  XP      Valeur de la pression si constante                         =
  15. C=======================================================================
  16.  
  17.       SUBROUTINE FPMA1D (IPTVPR,IPMAIL,IPTINT,IVAFOR,XP)
  18.  
  19.       IMPLICIT INTEGER(I-N)
  20.       IMPLICIT REAL*8 (A-H,O-Z)
  21.  
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC CCREEL
  26. -INC SMCHAML
  27. -INC SMELEME
  28. -INC SMINTE
  29. -INC SMCOORD
  30.  
  31.       SEGMENT WORK
  32.         REAL*8 XE(3,NBNN)
  33.       ENDSEGMENT
  34.  
  35.       SEGMENT MPTVAL
  36.         INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU)
  37.         CHARACTER*16 TYVAL(NCOSOU)
  38.       ENDSEGMENT
  39.  
  40. C= Quelques constantes (2.Pi et 4.Pi)
  41.       PARAMETER (X2Pi=6.283185307179586476925286766559D0)
  42.       PARAMETER (X4Pi=12.566370614359172953850573533118D0)
  43.  
  44.       IF (IPTVPR.NE.0) THEN
  45.         MELVA1=IPTVPR
  46.         SEGACT,MELVA1
  47.         IVA12=MELVA1.VELCHE(/2)
  48.       ENDIF
  49.  
  50.       MINTE=IPTINT
  51. C*    SEGACT,MINTE                               <- ACTIF en E/S
  52.       NBPGAU=POIGAU(/1)
  53.  
  54.       MELEME=IPMAIL
  55.       SEGACT,MELEME
  56.       NBNN=NUM(/1)
  57.       NBELEM=NUM(/2)
  58.  
  59. C*OF  IF ((NBPGAU.NE.1).OR.(NBNN.NE.1)) THEN
  60. C*OF    WRITE(6,*) 'ERREUR FATALE : FPMA1D'
  61. C*OF    RETURN
  62. C*OF  ENDIF
  63.  
  64.       SEGINI,WORK
  65.  
  66.       MPTVAL=IVAFOR
  67.       MELVAL=IVAL(1)
  68. C= BOUCLE SUR LES ELEMENTS
  69.       DO iElt=1,NBELEM
  70.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,iElt,XE)
  71. C= Cas des elements AXISymetriques et SPHEriques
  72.         IF (IFOUR.GE.12.AND.IFOUR.LE.14) THEN
  73.           T1=X2Pi*XE(1,1)
  74.         ELSE IF (IFOUR.EQ.15) THEN
  75.           RR=XE(1,1)
  76.           T1=X4Pi*RR*RR
  77.         ELSE
  78.           T1=1.
  79.         ENDIF
  80.         IF (IPTVPR.NE.0) THEN
  81.           IEMN=MIN(iElt,IVA12)
  82.           T1=MELVA1.VELCHE(1,IEMN)*T1
  83.         ELSE
  84.           T1=XP*T1
  85.         ENDIF
  86.         VELCHE(1,iElt)=VELCHE(1,iElt)+T1
  87.       ENDDO
  88.  
  89.       SEGSUP,WORK
  90.  
  91. C*    SEGDES,MINTE                               <- ACTIF en E/S
  92.       SEGDES,MELEME
  93.       IF (IPTVPR.NE.0) SEGDES,MELVA1
  94.  
  95.       RETURN
  96.       END
  97.  
  98.  
  99.  

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