Télécharger extr51.eso

Retour à la liste

Numérotation des lignes :

  1. C EXTR51 SOURCE CHAT 05/01/12 23:52:43 5004
  2. SUBROUTINE EXTR51(IPO1,IPOSI)
  3. **********************************************************************
  4. *
  5. * Extraction de l'objet contenu dans un NUAGE "colonne"
  6. * Correspondant a une composante donnee
  7. *
  8. * INTEGER (E) IPO1 pointeur sur l'objet NUAGE
  9. * INTEGER (E) IPOSI position informatique de la composante
  10. * souhaitee
  11. *
  12. **********************************************************************
  13. IMPLICIT INTEGER(I-N)
  14. -INC SMNUAGE
  15.  
  16. INTEGER IPO1,IPO2,IPO3,IPOSI,IDIM,IVAL
  17. CHARACTER*8 TYP1,MVAL
  18. LOGICAL LVAL
  19. REAL*8 XVAL
  20.  
  21. MNUAGE = IPO1
  22. SEGACT MNUAGE
  23. TYP1 = NUATYP(IPOSI)
  24. IF (TYP1.EQ.'FLOTTANT') THEN
  25. NUAVFL = NUAPOI(IPOSI)
  26. SEGACT NUAVFL
  27. IDIM = NUAFLO(/1)
  28. IF (IDIM.NE.1) THEN
  29. SEGDES NUAVFL
  30. SEGDES MNUAGE
  31. *------------- Le nuage n'est pas un nuage "colonne" -------------
  32. CALL ERREUR(670)
  33. RETURN
  34. ENDIF
  35. XVAL = NUAFLO(1)
  36. SEGDES NUAVFL
  37. SEGDES MNUAGE
  38. CALL ECRREE(XVAL)
  39. RETURN
  40. ELSE IF (TYP1.EQ.'INTEGER ') THEN
  41. NUAVIN = NUAPOI(IPOSI)
  42. SEGACT NUAVIN
  43. IDIM = NUAINT(/1)
  44. IF (IDIM.NE.1) THEN
  45. SEGDES NUAVIN
  46. SEGDES MNUAGE
  47. *------------- Le nuage n'est pas un nuage "colonne" -------------
  48. CALL ERREUR(670)
  49. RETURN
  50. ENDIF
  51. IVAL = NUAINT(1)
  52. SEGDES NUAVIN
  53. SEGDES MNUAGE
  54. CALL ECRENT(IVAL)
  55. RETURN
  56. ELSE IF (TYP1.EQ.'LOGIQUE ') THEN
  57. NUAVLO = NUAPOI(IPOSI)
  58. SEGACT NUAVLO
  59. IDIM = NUALOG(/1)
  60. IF (IDIM.NE.1) THEN
  61. SEGDES NUAVLO
  62. SEGDES MNUAGE
  63. *------------- Le nuage n'est pas un nuage "colonne" -------------
  64. CALL ERREUR(670)
  65. RETURN
  66. ENDIF
  67. LVAL = NUALOG(1)
  68. SEGDES NUAVLO
  69. SEGDES MNUAGE
  70. CALL ECRLOG(LVAL)
  71. RETURN
  72. ELSE IF (TYP1.EQ.'MOT ') THEN
  73. NUAVMO = NUAPOI(IPOSI)
  74. SEGACT NUAVMO
  75. IDIM = NUAMOT(/2)
  76. IF (IDIM.NE.1) THEN
  77. SEGDES NUAVMO
  78. SEGDES MNUAGE
  79. *------------- Le nuage n'est pas un nuage "colonne" -------------
  80. CALL ERREUR(670)
  81. RETURN
  82. ENDIF
  83. MVAL = NUAMOT(1)
  84. SEGDES NUAVMO
  85. SEGDES MNUAGE
  86. CALL ECRCHA(MVAL)
  87. RETURN
  88. ELSE
  89. IPO2 = NUAPOI(IPOSI)
  90. NUAVIN = IPO2
  91. SEGACT NUAVIN
  92. IDIM = NUAINT(/1)
  93. IF (IDIM.NE.1) THEN
  94. SEGDES NUAVIN
  95. SEGDES MNUAGE
  96. *------------- Le nuage n'est pas un nuage "colonne" -------------
  97. CALL ERREUR(670)
  98. RETURN
  99. ENDIF
  100. IPO3 = NUAINT(1)
  101. SEGDES NUAVIN
  102. SEGDES MNUAGE
  103. CALL ECROBJ(TYP1,IPO3)
  104. RETURN
  105. ENDIF
  106.  
  107. END
  108.  
  109.  

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