Esope source files

   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 = ' '
  34 :       CALL QUETYP(ITOPE,0,IRETOU) 
  35 :       IF (IERR.NE.0) RETURN
  36 :       IF (IRETOU.EQ.0) GOTO 700
  37 :       DO KMOT=1,LITY2(/2)
  38 :         IF (ITOPE.EQ.LITY2(KMOT)) GOTO 201
  39 :       ENDDO
  40 :       if( itope.eq.'TABLE   ') go to 201
  41 : c on continue le calcul avec les donnees deja entrees
  42 :       RETURN
  43 :  201  CONTINUE     
  43 :       CALL LIROBJ(ITOPE,IPOIN1,1,IRETOU)
  44 :       If(itope.EQ.'TABLE  ') then
  45 :         if(itab.ne.0) then
  45 :           call erreur(21)
  46 :           return
  47 :         endif
  48 :         mtab1=ipoin1
  49 :         segini,mtable=mtab1
  50 :         itab=mtable
  51 :         segini iposi
  52 :         ib=0
  53 :         do ia=1,mlotab
  54 :           itope=mtabtv(ia)
  55 :           do kmot=1,lity2(/2)
  56 :             if(itope.eq.lity2(kmot) ) go to 204
  57 :           enddo
  58 :           go to 222
  59 :   204     continue
  60 :           ib=ib+1
  61 :           iposit(ib)=ia
  62 :           SEGINI DSOBJ
  63 :           PILO(**) = DSOBJ
  64 :           INIPOI = mtabiv(ia)
  65 :           INIFIN = 0
  66 :           LETYP = mtabtv(ia)
  67 :           SEGDES DSOBJ
  68 :   222     continue
  69 :         enddo
  70 :        segdes mtable,iposi      
  71 :       go to 203
  72 :       endif
  73 :       SEGINI DSOBJ
  74 :       PILO(**) = DSOBJ
  75 :       INIPOI = IPOIN1
  76 :       LETYP = ITOPE
  77 :       INIFIN = 0
  78 :       SEGDES DSOBJ
  79 :       GOTO 203
  80 :  
  81 :  700  CONTINUE
  82 :       SEGDES MLITY,PILO
  83 :       RETURN
  84 :      
  85 :       END
  86 :  
  87 :  
  88 :  
  89 :