Télécharger empil1.eso

Retour à la liste

Numérotation des lignes :

  1. C EMPIL1 SOURCE CHAT 11/06/08 21:15:23 7001
  2. C EMPIL1
  3. C----------------------------------------------------------------
  4. C Ce sous-programme saisit les objets dans la pile, cas particulier
  5. C des tables
  6. C----------------------------------------------------------------
  7. SUBROUTINE EMPIL1(IP1,MLITY,IRETOU,itab,iposi)
  8. IMPLICIT INTEGER(I-N)
  9. IMPLICIT REAL*8 (A-H,O-Z)
  10. -INC CCOPTIO
  11. -INC SMCOORD
  12. -INC SMTABLE
  13. -INC SMELEME
  14. SEGMENT MLITY
  15. CHARACTER*8 LITY2(NTY2)
  16. ENDSEGMENT
  17. CHARACTER*8 ITOPE,ity1
  18. SEGMENT PILO(0)
  19. SEGMENT DSOBJ
  20. INTEGER INIPOI,INIFIN
  21. CHARACTER*8 LETYP
  22. ENDSEGMENT
  23. SEGMENT IPOSI
  24. Integer iposit(mlotab)
  25. ENDSEGMENT
  26. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  27.  
  28. c pile des arguments
  29. IRETOU = 0
  30. SEGINI PILO
  31. IP1 = PILO
  32. SEGACT MLITY
  33. 203 CONTINUE
  34. ITOPE = ' '
  35. CALL QUETYP(ITOPE,0,IRETOU)
  36. IF (IERR.NE.0) RETURN
  37. IF (IRETOU.EQ.0) GOTO 700
  38. DO KMOT=1,LITY2(/2)
  39. IF (ITOPE.EQ.LITY2(KMOT)) GOTO 201
  40. ENDDO
  41. if( itope.eq.'TABLE ') go to 201
  42. c on continue le calcul avec les donnees deja entrees
  43. RETURN
  44. 201 CONTINUE
  45. CALL LIROBJ(ITOPE,IPOIN1,1,IRETOU)
  46. If(itope.EQ.'TABLE ') then
  47. if(itab.ne.0) then
  48. call erreur(21)
  49. return
  50. endif
  51. mtab1=ipoin1
  52. segini,mtable=mtab1
  53. itab=mtable
  54. segini iposi
  55. ib=0
  56. do ia=1,mlotab
  57. itope=mtabtv(ia)
  58. do kmot=1,lity2(/2)
  59. if(itope.eq.lity2(kmot) ) go to 204
  60. enddo
  61. go to 222
  62. 204 continue
  63. ib=ib+1
  64. iposit(ib)=ia
  65. SEGINI DSOBJ
  66. PILO(**) = DSOBJ
  67. INIPOI = mtabiv(ia)
  68. INIFIN = 0
  69. LETYP = mtabtv(ia)
  70. SEGDES DSOBJ
  71. 222 continue
  72. enddo
  73. segdes mtable,iposi
  74. go to 203
  75. endif
  76. SEGINI DSOBJ
  77. PILO(**) = DSOBJ
  78. INIPOI = IPOIN1
  79. LETYP = ITOPE
  80. INIFIN = 0
  81. SEGDES DSOBJ
  82. GOTO 203
  83.  
  84. 700 CONTINUE
  85. SEGDES MLITY,PILO
  86. RETURN
  87.  
  88. END
  89.  
  90.  
  91.  
  92.  
  93.  

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