Télécharger la plaquette Cast3M


fr en

Télécharger table.eso

Retour à la liste

Numérotation des lignes : 

table

  1. C TABLE     SOURCE    CB215821  16/04/15    21:15:42     8907
  2.       SUBROUTINE TABLE
  3. ************************************************************************
  4. *
  5. *                              T A B L E
  6. *                              ---------
  7. *
  8. *            SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "TABLE"
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. *     DEFINIR UN OBJET DE TYPE 'TABLE'
  14. *     OU EN RENOMMER UN
  15. * PHRASE D'APPEL (EN GIBIANE):
  16. * ----------------------------
  17. *
  18. *     A = TABLE ;      OU    B = TABLE A;
  19. *
  20. * CREATION D'UNE TABLE DE SOUS-TYPE VECTEUR :
  21. *     A = TABLE VECTEUR ;
  22. *
  23. * AUTEUR, DATE DE CREATION:
  24. * -------------------------
  25. *
  26. *     PASCAL MANIGOT     5 DECEMBRE 1984    PV 12 11 1986
  27. *
  28. * LANGAGE:
  29. * --------
  30. *
  31. *     FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS
  32. *
  33. ************************************************************************
  34. *
  35. *
  36.       IMPLICIT INTEGER(I-N)
  37.       IMPLICIT REAL*8 (A-H,O-Z)
  38. -INC CCNOYAU
  39. -INC SMTABLE
  40.       POINTEUR IPTABL.MTABLE
  41.       CHARACTER*8 ICHA,TYPOBJ
  42.       LOGICAL LOGI
  43.       CHARACTER*72 SOUTYP
  44.  
  45.       LOGI=.FALSE.
  46.       IPO = 0
  47.  
  48.       CALL LIROBJ('TABLE',IPTABL,0,IRETOU)
  49.       IF (IRETOU.EQ.0) THEN
  50.          CALL CRTABL(IPTABL)
  51.          SEGDES IPTABL
  52.       ELSE
  53.          CALL REFUS
  54.          RETURN
  55.       ENDIF
  56. * lecture de la procedur sans la lire et initialisation des methodes
  57. * generiques des objets tables
  58.       CALL LIROBJ('PROCEDUR',IRET,0,IRETOU)
  59.       IF( IRETOU.NE.0) THEN
  60.       CALL QUENOM(ICHA)
  61.       CALL REFUS
  62.       CALL ECCTAB(IPTABL,'MOT     ',0,0.D0,'CLASSE',LOGI,IRET,
  63.      $      'MOT     ',0, 0.D0, ICHA(1:8),LOGI,IRET)
  64. * mettre ici les methodes génériques
  65.       ICHA = 'METHODE'
  66.       CALL ECCTAB(IPTABL,ICHA,0,0.D0,'METHODE',LOGI,IPO,
  67.      $        'MOT',0,0.D0,'METHODE',LOGI,0)
  68.       TYPOBJ='PROCEDUR'
  69.       CALL POSCHA('HERITE',IPO)
  70.       TYPOBJ='PROCEDUR'
  71.       DO 1 J =LMNNOM,1,-1
  72.       IF(IPO.NE.INOOB1(J)) GOTO 1
  73.          IPLAMO = IOUEP2(J)
  74.          GO TO  2
  75.   1   CONTINUE
  76.       CALL ERREUR(5)
  77.   2   CONTINUE
  78.       CALL ECCTAB(IPTABL,ICHA,0,0.D0,'HERITE',LOGI,IPO,
  79.      $        'PROCEDUR',0,0.D0,ICHA,LOGI,IPLAMO)
  80.        CALL ECROBJ ('TABLE',IPTABL)
  81.        ELSE
  82. * LECTURE DE L'EVENTUEL SOUS-TYPE
  83.          CALL LIRCHA(SOUTYP,0,IRET)
  84.        IF (IRET.NE.0) then
  85.         CALL ECCTAB(IPTABL,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,
  86.      #                    0,'MOT',0,0.D0,SOUTYP(1:IRET),.TRUE.,0)
  87.         IF (SOUTYP.eq.'ESCLAVE ')
  88.      >  CALL ECCTAB(IPTABL,'MOT',0,0.D0,'CREATEUR',.TRUE.,
  89.      #                    0,'MOT',0,0.D0,'TABLE   ',.TRUE.,0)
  90.        ENDIF
  91.        ENDIF
  92.        CALL ECROBJ ('TABLE',IPTABL)
  93.       LECTAB=1
  94. *
  95.       END
  96.  
  97.  
  98.  

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