Télécharger la plaquette Cast3M


fr en

Télécharger xtx2.eso

Retour à la liste

Numérotation des lignes : 

xtx2

  1. C XTX2      SOURCE    OF166741  24/10/03    21:15:44     12022          
  2. *_______________________________________________________________________
  3. *
  4. *              OPERATEUR XTX
  5. *
  6. *    ENTREE :
  7. *    --------
  8. *        IPCHE1   POINTEUR SUR UN MCHAM
  9. *
  10. *
  11. *    SORTIE :
  12. *    --------
  13. *        XFLOT    NORME DU CHAMELEM
  14. *        IRET     =1 OU 0 SUIVANT SUCCES OU PAS
  15. *_______________________________________________________________________
  16.  
  17.       SUBROUTINE XTX2(IPCHE1,XFLOT,IRET)
  18.  
  19.       IMPLICIT INTEGER(I-N)
  20.       IMPLICIT REAL*8(A-H,O-Z)
  21.  
  22. -INC PPARAM
  23. -INC CCOPTIO
  24.  
  25. -INC SMELEME
  26. -INC SMINTE
  27. -INC SMLREEL
  28. -INC SMCHAML
  29.  
  30.       IRET = 0
  31.       CALL ACTOBJ('MCHAML  ',IPCHE1,1)
  32.       IF (IERR.NE.0) RETURN
  33.  
  34.       MCHELM = IPCHE1
  35.       NSOUS=ICHAML(/1)
  36.  
  37.       XFLOT=0.D0
  38. *
  39. *     BOUCLE SUR LES SOUS REFERENCES
  40. *
  41.       DO 100 ISOUS=1,NSOUS
  42. *
  43. *        RECUPERATION DES CARACTERISTIQUES DU CHAMELEM
  44. *
  45.          MELEME=IMACHE(ISOUS)
  46.          NBELEM=NUM(/2)
  47.  
  48.          MINTE=INFCHE(ISOUS,4)
  49.          IF (MINTE.EQ.0) THEN
  50.             NBPGAU=NUM(/1)
  51.          ELSE
  52.             NBPGAU=POIGAU(/1)
  53.          ENDIF
  54. *
  55.          MCHAML=ICHAML(ISOUS)
  56.          NCOMP=IELVAL(/1)
  57. *
  58.          DO 110 ICOMP=1,NCOMP
  59.             MELVAL=IELVAL(ICOMP)
  60.             IF (TYPCHE(ICOMP).EQ.'REAL*8') THEN
  61.                DO 200 IGAU=1,NBPGAU
  62.                   IGMN=MIN(IGAU,VELCHE(/1))
  63.                   DO 200 IB=1,NBELEM
  64.                      IBMN=MIN(IB,VELCHE(/2))
  65.                      XX=VELCHE(IGMN,IBMN)
  66.                      XFLOT=XFLOT+XX*XX
  67.  200           CONTINUE
  68.             ELSE IF (TYPCHE(ICOMP).EQ.'POINTEURLISTREEL') THEN
  69.                DO 201 IGAU=1,NBPGAU
  70.                   IGMN=MIN(IGAU,IELCHE(/1))
  71.                   DO 201 IB=1,NBELEM
  72.                      IBMN=MIN(IB,IELCHE(/2))
  73.                      MLREEL=IELCHE(IGMN,IBMN)
  74. c*                     SEGACT MLREEL
  75.                      DO 120 IPROG=1,PROG(/1)
  76.                         XX=PROG(IPROG)
  77.                         XFLOT=XFLOT+XX*XX
  78.  120                 CONTINUE
  79.  201           CONTINUE
  80.             ELSE
  81.                MOTERR(1:4)=NOMCHE(ICOMP)
  82.                CALL ERREUR (197)
  83.                GOTO 666
  84.             ENDIF
  85.  110     CONTINUE
  86.  100  CONTINUE
  87.       IRET = 1
  88.       RETURN
  89.  
  90.  666  CONTINUE
  91.       IRET=0
  92.       RETURN
  93.       END
  94.  
  95.  
  96.  

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