Esope source files

   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 : -INC CCOPTIO
  23 : -INC CCREEL
  24 : -INC SMCHAML
  25 : -INC SMELEME
  26 : -INC SMINTE
  27 : -INC SMCOORD
  28 : 
  29 :       SEGMENT WORK
  30 :         REAL*8 XE(3,NBNN)
  31 :       ENDSEGMENT
  32 : 
  33 :       SEGMENT MPTVAL
  34 :         INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU)
  35 :         CHARACTER*16 TYVAL(NCOSOU)
  36 :       ENDSEGMENT
  37 : 
  38 : C= Quelques constantes (2.Pi et 4.Pi)
  39 :       PARAMETER (X2Pi=6.283185307179586476925286766559D0)
  40 :       PARAMETER (X4Pi=12.566370614359172953850573533118D0)
  41 : 
  42 :       IF (IPTVPR.NE.0) THEN
  43 :         MELVA1=IPTVPR
  44 :         SEGACT,MELVA1
  45 :         IVA12=MELVA1.VELCHE(/2)
  46 :       ENDIF
  47 : 
  48 :       MINTE=IPTINT
  49 : C*    SEGACT,MINTE                               <- ACTIF en E/S
  50 :       NBPGAU=POIGAU(/1)
  51 : 
  52 :       MELEME=IPMAIL
  53 :       SEGACT,MELEME
  54 :       NBNN=NUM(/1)
  55 :       NBELEM=NUM(/2)
  56 : 
  57 : C*OF  IF ((NBPGAU.NE.1).OR.(NBNN.NE.1)) THEN
  58 : C*OF    WRITE(6,*) 'ERREUR FATALE : FPMA1D'
  59 : C*OF    RETURN
  60 : C*OF  ENDIF
  61 : 
  62 :       SEGINI,WORK
  63 : 
  64 :       MPTVAL=IVAFOR
  65 :       MELVAL=IVAL(1)
  66 : C= BOUCLE SUR LES ELEMENTS
  67 :       DO iElt=1,NBELEM
  67 :         CALL DOXE(XCOOR,IDIM,NBNN,NUM,iElt,XE)
  68 : C= Cas des elements AXISymetriques et SPHEriques
  69 :         IF (IFOUR.GE.12.AND.IFOUR.LE.14) THEN
  70 :           T1=X2Pi*XE(1,1)
  71 :         ELSE IF (IFOUR.EQ.15) THEN
  72 :           RR=XE(1,1)
  73 :           T1=X4Pi*RR*RR
  74 :         ELSE
  75 :           T1=1.
  76 :         ENDIF
  77 :         IF (IPTVPR.NE.0) THEN
  78 :           IEMN=MIN(iElt,IVA12)
  79 :           T1=MELVA1.VELCHE(1,IEMN)*T1
  80 :         ELSE
  81 :           T1=XP*T1
  82 :         ENDIF
  83 :         VELCHE(1,iElt)=VELCHE(1,iElt)+T1
  84 :       ENDDO
  85 : 
  86 :       SEGSUP,WORK
  87 : 
  88 : C*    SEGDES,MINTE                               <- ACTIF en E/S
  89 :       SEGDES,MELEME
  90 :       IF (IPTVPR.NE.0) SEGDES,MELVA1
  91 : 
  92 :       RETURN
  93 :       END
  94 : 
  95 :