Numérotation des lignes :

C EMPIL1    SOURCE    CHAT      11/06/08    21:15:23     7001C EMPIL1C----------------------------------------------------------------C Ce sous-programme saisit les objets dans la pile, cas particulierC des tablesC----------------------------------------------------------------      SUBROUTINE EMPIL1(IP1,MLITY,IRETOU,itab,iposi)      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z)-INC CCOPTIO-INC SMCOORD-INC SMTABLE-INC SMELEME      SEGMENT MLITY        CHARACTER*8 LITY2(NTY2)      ENDSEGMENT      CHARACTER*8 ITOPE,ity1      SEGMENT PILO(0)      SEGMENT DSOBJ        INTEGER INIPOI,INIFIN        CHARACTER*8 LETYP      ENDSEGMENT      SEGMENT IPOSI        Integer iposit(mlotab)      ENDSEGMENT      SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) c pile des arguments      IRETOU = 0      SEGINI PILO      IP1 = PILO      SEGACT MLITY 203  CONTINUE      ITOPE = ' '      CALL QUETYP(ITOPE,0,IRETOU)      IF (IERR.NE.0) RETURN      IF (IRETOU.EQ.0) GOTO 700      DO KMOT=1,LITY2(/2)        IF (ITOPE.EQ.LITY2(KMOT)) GOTO 201      ENDDO      if( itope.eq.'TABLE   ') go to 201c on continue le calcul avec les donnees deja entrees      RETURN 201  CONTINUE      CALL LIROBJ(ITOPE,IPOIN1,1,IRETOU)      If(itope.EQ.'TABLE  ') then        if(itab.ne.0) then          call erreur(21)          return        endif        mtab1=ipoin1        segini,mtable=mtab1        itab=mtable        segini iposi        ib=0        do ia=1,mlotab          itope=mtabtv(ia)          do kmot=1,lity2(/2)            if(itope.eq.lity2(kmot) ) go to 204          enddo          go to 222  204     continue          ib=ib+1          iposit(ib)=ia          SEGINI DSOBJ          PILO(**) = DSOBJ          INIPOI = mtabiv(ia)          INIFIN = 0          LETYP = mtabtv(ia)          SEGDES DSOBJ  222     continue        enddo       segdes mtable,iposi      go to 203      endif      SEGINI DSOBJ      PILO(**) = DSOBJ      INIPOI = IPOIN1      LETYP = ITOPE      INIFIN = 0      SEGDES DSOBJ      GOTO 203  700  CONTINUE      SEGDES MLITY,PILO      RETURN       END

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