Télécharger xtx2.eso

Retour à la liste

Numérotation des lignes :

  1. C XTX2 SOURCE PV 09/03/12 21:37:30 6325
  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. -INC CCOPTIO
  26. -INC SMELEME
  27. -INC SMINTE
  28. -INC SMLREEL
  29. *
  30. IRET=1
  31. MCHELM=IPCHE1
  32. SEGACT MCHELM
  33. NSOUS=ICHAML(/1)
  34. XFLOT=0.D0
  35. *
  36. * BOUCLE SUR LES SOUS REFERENCES
  37. *
  38. DO 100 ISOUS=1,NSOUS
  39. *
  40. * RECUPERATION DES CARACTERISTIQUES DU CHAMELEM
  41. *
  42. MELEME=IMACHE(ISOUS)
  43. SEGACT MELEME
  44. NBELEM=NUM(/2)
  45. *
  46. MINTE=0
  47. IF (INFCHE(/2).GE.4) MINTE=INFCHE(ISOUS,4)
  48. IF (MINTE.EQ.0) THEN
  49. NBPGAU=NUM(/1)
  50. ELSE
  51. SEGACT MINTE
  52. NBPGAU=POIGAU(/1)
  53. SEGDES MINTE
  54. ENDIF
  55. SEGDES MELEME
  56. *
  57. MCHAML=ICHAML(ISOUS)
  58. SEGACT MCHAML
  59. NCOMP=IELVAL(/1)
  60. *
  61. DO 110 ICOMP=1,NCOMP
  62. MELVAL=IELVAL(ICOMP)
  63. SEGACT MELVAL
  64. IF (TYPCHE(ICOMP).EQ.'REAL*8') THEN
  65. DO 200 IGAU=1,NBPGAU
  66. IGMN=MIN(IGAU,VELCHE(/1))
  67. DO 200 IB=1,NBELEM
  68. IBMN=MIN(IB,VELCHE(/2))
  69. XX=VELCHE(IGMN,IBMN)
  70. XFLOT=XFLOT+XX*XX
  71. 200 CONTINUE
  72. ELSE IF (TYPCHE(ICOMP).EQ.'POINTEURLISTREEL') THEN
  73. DO 201 IGAU=1,NBPGAU
  74. IGMN=MIN(IGAU,IELCHE(/1))
  75. DO 201 IB=1,NBELEM
  76. IBMN=MIN(IB,IELCHE(/2))
  77. MLREEL=IELCHE(IGMN,IBMN)
  78. SEGACT MLREEL
  79. DO 120 IPROG=1,PROG(/1)
  80. XX=PROG(IPROG)
  81. XFLOT=XFLOT+XX*XX
  82. 120 CONTINUE
  83. SEGDES MLREEL
  84. 201 CONTINUE
  85. ELSE
  86. MOTERR(1:4)=NOMCHE(ICOMP)
  87. CALL ERREUR (197)
  88. GOTO 666
  89. ENDIF
  90. SEGDES MELVAL
  91. 110 CONTINUE
  92. SEGDES MCHAML
  93. 100 CONTINUE
  94. SEGDES MCHELM
  95. RETURN
  96. *
  97. 666 CONTINUE
  98. SEGDES MELVAL
  99. SEGDES MCHAML
  100. SEGDES MCHELM
  101. IRET=0
  102. RETURN
  103. END
  104.  
  105.  
  106.  
  107.  

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