Télécharger la plaquette Cast3M


fr en

Télécharger muchpo.eso

Retour à la liste

Numérotation des lignes : 

muchpo

  1. C MUCHPO    SOURCE    CB215821  20/11/25    13:34:37     10792          
  2.       SUBROUTINE MUCHPO(IPO1,XFLOT,IRET,IEPS)
  3. C=======================================================================
  4. C
  5. C     MULTIPLIE UN CHPS PAR POINT PAR XFLO  SI IEPS=1
  6. C     MULTIPLIE UN CHPS PAR POINT PAR 1/XFLO SI IEPS=-1
  7. C     LE CHPS RESULTANT VOIT SON POINTEUR STOCKE DANS IRET
  8. C     SI L OPERATION N EST PAS POSSIBLE IRET=0
  9. C        PAR EXAMPLE SI IEPS=-1 ET XFLOT=0.
  10. C  ENTREES
  11. C     IPO1=POINTEUR SUR LE CHAMPOINT
  12. C     XFLOT=SCALAIRE
  13. C     IEPS=1 SI MULTIPLICATION -1 SI DIVISION
  14. C  SORTIES
  15. C     IRET=POINTEUR SUR LE CHAMPS*XFLOT**IEPS
  16. C         =0 SI L OPERATION EST IMPOSSSIBLE
  17. C
  18. C     CODE EBERSOLT JUIN 84
  19. C     ATTENTION LES CHAMPS PAR ELEMENTS SONT EN DOUBLE PRECISION
  20. C     SI ON VOULAIT PASSER EN SIMPLE IL FAUT CHANGER VELCHA EN VELCHD
  21. C
  22. C=======================================================================
  23.       IMPLICIT INTEGER(I-N)
  24.       IMPLICIT REAL*8(A-H,O-Z)
  25. -INC SMCHPOI
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29.       IRET=0
  30.       IF(IEPS.EQ.-1.AND.XFLOT.EQ.0.) GOTO 666
  31.       IF(IEPS.EQ.1)  XFLOT1=XFLOT
  32.       IF(IEPS.EQ.-1) XFLOT1=1.D0/XFLOT
  33.       MCHPO1=IPO1
  34.       SEGACT MCHPO1
  35.       NSOUPO=MCHPO1.IPCHP(/1)
  36.       NAT=MCHPO1.JATTRI(/1)
  37.       SEGINI MCHPOI
  38.       IRET=MCHPOI
  39.       MTYPOI=MCHPO1.MTYPOI
  40.       IFOPOI   =MCHPO1.IFOPOI
  41.       MOCHDE=MCHPO1.MOCHDE
  42.       DO 50 IN = 1,NAT
  43.       JATTRI(IN) = MCHPO1.JATTRI(IN)
  44.   50  CONTINUE
  45. *
  46.       DO 72 IA=1,NSOUPO
  47.         MSOUP1=MCHPO1.IPCHP(IA)
  48.         SEGACT MSOUP1
  49.         NC=MSOUP1.NOCOMP(/2)
  50.         SEGINI MSOUPO
  51.         IPCHP(IA)=MSOUPO
  52.         IGEOC=MSOUP1.IGEOC
  53. *
  54.         DO 73 IB=1,NC
  55.           NOCOMP(IB)=MSOUP1.NOCOMP(IB)
  56.           NOHARM(IB)=MSOUP1.NOHARM(IB)
  57.   73    CONTINUE
  58. *
  59.         MPOVA1=MSOUP1.IPOVAL
  60.         SEGACT MPOVA1
  61.         N=MPOVA1.VPOCHA(/1)
  62.         NC=MPOVA1.VPOCHA(/2)
  63.         SEGINI MPOVAL
  64.         IPOVAL=MPOVAL
  65. *
  66.         DO 75 IB=1,N
  67.           DO 76 IC=1,NC
  68.              VPOCHA(IB,IC)=XFLOT1*MPOVA1.VPOCHA(IB,IC)
  69.   76      CONTINUE
  70.   75    CONTINUE
  71. *
  72.   72  CONTINUE
  73.   666 CONTINUE
  74.       END
  75.  
  76.  
  77.  
  78.  

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