Sources Esope | Cast3M

fpeltu
C FPELTU    SOURCE    PV090527  24/04/04    21:15:15     11875          
C_______________________________________________________________________
C
C        CALCUL DES FORCES DE PRESSION POUR LES ELEMENTS TUYAU
C
C  ENTREES:
C  ________
C
C     IPTVPR  Pointeur sur un MELVAL contenant les pressions appliquees
C     IVACAR  Pointeur sur un MCHAML de CARACTERISTIQUES
C     IPMAIL  Pointeur sur un MELEME
C     ISOUS   Entier indiquant la zone elementaire traitee
C             (info necessaire dans l'affichage des erreurs 128 et 138)
C
C  SORTIES:
C  ________
C
C     IVAFOR  Pointeur sur un MPTVAL de forces aux noeuds
C_______________________________________________________________________
C
      SUBROUTINE FPELTU(IPTVPR,IVACAR,IPMAIL,ISOUS,IVAFOR)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
-INC SMCOORD
-INC SMELEME
-INC SMCHAML
 
      SEGMENT MPTVAL
        INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU)
        CHARACTER*16 TYVAL(NCOSOU)
      ENDSEGMENT
 
      DIMENSION XFORC(12),WORK(12),VECT(3)
      DIMENSION XE(3,2),P(3,3),XX(2),YY(2),ZZ(2)
 
      MELEME=IPMAIL
      NBELEM=NUM(/2)
 
C= BOUCLE SUR LES ELEMENTS
      DO 103 IB=1,NBELEM
C
        CALL DOXE(XCOOR,3,2,NUM,IB,XE)
        DO 105 J=1,2
          XX(J)=XE(1,J)
          YY(J)=XE(2,J)
          ZZ(J)=XE(3,J)
 105    CONTINUE
C
        XLON2=(XX(2)-XX(1))**2+(YY(2)-YY(1))**2+(ZZ(2)-ZZ(1))**2
        XLON=SQRT(XLON2)
        IF (XLON.NE.0.D0) GOTO 106
C
        INTERR(1)=ISOUS
        INTERR(2)=IB
        CALL ERREUR(128)
        RETURN
C
 106    CONTINUE
C
C       ON CHERCHE LES CARACTERISTIQUES
C
        CALL ZERO(XFORC,1,12)
        MPTVAL=IVACAR
        NBCAR=IVAL(/1)
C
        MELVAL=IVAL(1)
        IBMN=MIN(IB,VELCHE(/2))
        EPAI=VELCHE(1,IBMN)
C
        MELVAL=IVAL(2)
        REXT=VELCHE(1,IBMN)
C
        IF (IPTVPR.EQ.0) THEN
          MELVAL=IVAL(3)
        ELSE
          MELVAL=IPTVPR
        ENDIF
        PRES=VELCHE(1,IBMN)
C
        IF (IVAL((NBCAR-3)).NE.0) THEN
          MELVAL=IVAL((NBCAR-3))
          RACO=VELCHE(1,IBMN)
        ELSE
          RACO=0.
        ENDIF
C
        IF (IVAL((NBCAR-2)).NE.0) THEN
          MELVAL=IVAL((NBCAR-2))
          VECT(1)=VELCHE(1,IBMN)
        ELSE
          VECT(1)=0.
        ENDIF
C
        IF (IVAL((NBCAR-1)).NE.0) THEN
          MELVAL=IVAL((NBCAR-1))
          VECT(2)=VELCHE(1,IBMN)
        ELSE
          VECT(2)=0.
        ENDIF
C
        IF (IVAL((NBCAR  )).NE.0) THEN
          MELVAL=IVAL((NBCAR  ))
          VECT(3)=VELCHE(1,IBMN)
        ELSE
          VECT(3)=0.
        ENDIF
C
C
        RINT=REXT-EPAI
        FL=XPI*PRES*RINT**2
        IF (RACO.NE.0.D0) THEN
          FL=FL/SQRT(1.D0-0.25D0*XLON2/RACO**2)
        ENDIF
        CALL ZERO(WORK,1,12)
        WORK(1)=-FL
        WORK(7)=FL
C
        CALL POUPAS(XX,YY,ZZ,VECT,P,KERRE)
        IF (KERRE.EQ.0) GOTO 107
C
        INTERR(1)=ISOUS
        INTERR(2)=IB
        CALL ERREUR(138)
        RETURN
C
 107    CONTINUE
        CALL POUVEC(WORK,XFORC,P,2)
        IE=0
C
C       REMPLISSAGE DU SEGMENT CONTENANT LES FORCES
C
        MPTVAL=IVAFOR
        DO     IGAU=1,2
          DO     ICOMP=1,6
            MELVAL=IVAL(ICOMP)
            IGMN=MIN(IGAU,VELCHE(/1))
            IBMN=MIN(IB  ,VELCHE(/2))
            IE=IE+1
            VELCHE(IGMN,IBMN)=XFORC(IE)
          enddo     
        enddo     
C
 103  CONTINUE
 
      END