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

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