Télécharger la plaquette Cast3M


fr en

Télécharger lire01.eso

Retour à la liste

Numérotation des lignes : 

lire01

  1. C LIRE01    SOURCE    CB215821  17/04/20    21:15:18     9406           
  2.       SUBROUTINE LIRE01 (IPOIN1,IPOS,IPOIN2)
  3. ************************************************************************
  4. *
  5. *                             L I R E 0 1
  6. *                             -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. *     LIRE 2 OBJETS, L'UN ETANT UN INDICE DE POSITION DANS L'AUTRE
  12. *     (UTILISE, A L'ORIGINE, POUR LES OPERATEURS "EXTRAIRE" ET
  13. *     "ENLEVER").
  14. *
  15. * MODE D'APPEL:
  16. * -------------
  17. *
  18. *     CALL LIRE01 (IPOIN1,IPOS,IPOIN2)
  19. *
  20. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE
  21. * -----------
  22. *
  23. *     IPOS    ENTIER    (E)  IPOS<>0  IPOIN2 PEUT ETRE UN LISTENTI
  24. *                            IPOS=0   IPOIN2 NE PEUT PAS ETRE UN LISTENTI
  25. *
  26. *     IPOIN1  ENTIER    (S)  POINTEUR SUR LA LISTE A MODIFIER
  27. *
  28. *     IPOIN2  ENTIER    (S)  POINTEUR SUR LA LISTE D'INDICES DE POSITION
  29. *                            (OU L'INDICE DE POSITION LUI-MEME).
  30. *
  31. *     IPOS    ENTIER    (S)  CHIFFRE INDIQUANT LES TYPES POINTES PAR
  32. *                            IPOIN1 ET IPOIN2
  33. *
  34. *                            |IPOS|=1 :: IPOIN1=LISTREEL
  35. *                            |IPOS|=2 :: IPOIN1=LISTENTI
  36. *                            |IPOS|=3 :: IPOIN1=LISTMOTS
  37. *                            |IPOS|=4 :: IPOIN1=LISTCHPO
  38. *
  39. *                             IPOS>0  :: IPOIN2=ENTIER
  40. *                             IPOS<0  :: IPOIN2=LISTENTI
  41. *
  42. *                             IPOS =0 :: PAS D'OBJET "LISTxxxx" TROUVÉ
  43. *
  44. *
  45. * MODE DE FONCTIONNEMENT
  46. * ----------------------
  47. *
  48. *
  49. *    SUITE  A MODIF IL N'EST PLUS POSSIBLE DE LIRE UNE TABLE.
  50. *
  51. *
  52. * SOUS-PROGRAMMES APPELES:
  53. * ------------------------
  54. *
  55. *     LIRE, LIRENT
  56. *
  57. * AUTEUR, DATE DE CREATION:
  58. * -------------------------
  59. *
  60. *     PASCAL MANIGOT     5 DECEMBRE 1984
  61. *         DATE DE MODIFICATION   22 JANVIER 1988
  62. * LANGAGE:
  63. * --------
  64. *
  65. *     FORTRAN77
  66. *
  67. ************************************************************************
  68. *
  69.       IMPLICIT INTEGER(I-N)
  70.  
  71.  
  72. -INC PPARAM
  73. -INC CCOPTIO
  74.  
  75.       CHARACTER*(8) CMOT
  76.       LOGICAL ZLENTI
  77.  
  78.       PARAMETER   (NBMO=4)
  79.       CHARACTER*8  CLIST(NBMO)
  80.  
  81.       DATA CLIST /'LISTREEL','LISTENTI','LISTMOTS','LISTCHPO'/
  82.  
  83. *     AUTORISE-T-ON INDIC1 A ETRE DE TYPE LISTENTI ?
  84.       ZLENTI=(IPOS.NE.0)
  85.  
  86.  
  87. *     LECTURE DE OBJET1 DANS IPOIN1
  88.       CALL QUETYP(CMOT,0,IRETOU)
  89.       IF (IRETOU.EQ.0) THEN
  90.         CALL ERREUR(533)
  91.         RETURN
  92.       ENDIF
  93.  
  94.       CALL PLACE(CLIST,NBMO,IPOS,CMOT)
  95.       IF (IPOS.EQ.0) THEN
  96.         MOTERR(1:8)=CMOT
  97.         CALL ERREUR(39)
  98.         RETURN
  99.       ELSE
  100.           CALL LIROBJ(CMOT,IPOIN1,1,IRETOU)
  101.       ENDIF
  102.  
  103.  
  104. *     LECTURE DE INDIC1 DANS IPOIN2
  105.       CALL QUETYP(CMOT,0,IRETOU)
  106.       IF (IRETOU.EQ.0) THEN
  107.         CALL ERREUR(533)
  108.         RETURN
  109.       ENDIF
  110.  
  111.       IF (CMOT.EQ.'ENTIER') THEN
  112.         ISGN=1
  113.         CALL LIRENT (IPOIN2,1,IRETOU)
  114.         IF (IERR.NE.0) RETURN
  115.       ELSEIF (ZLENTI.AND.CMOT.EQ.'LISTENTI') THEN
  116.         ISGN=-1
  117.         CALL LIROBJ('LISTENTI',IPOIN2,1,IRETOU)
  118.         IF (IERR.NE.0) RETURN
  119.       ELSE
  120.         MOTERR(1:8)=CMOT
  121.         CALL ERREUR(39)
  122.         RETURN
  123.       ENDIF
  124.       IPOS=IPOS*ISGN
  125.  
  126.       RETURN
  127.       END
  128.  
  129.  

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