Télécharger la plaquette Cast3M


fr en

Télécharger empil1.eso

Retour à la liste

Numérotation des lignes : 

empil1

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

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