Télécharger la plaquette Cast3M


fr en

Télécharger rempl1.eso

Retour à la liste

Numérotation des lignes : 

rempl1

  1. C REMPL1    SOURCE    JC220346  12/05/15    21:15:03     7370
  2.       SUBROUTINE REMPL1 (IPOINT,IEME,REELDP,IPLISR,IPOS)
  3. ************************************************************************
  4. *
  5. *                             R E M P L 1
  6. *                             -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. *     REMPLACER LE I-EME ELEMENT D'UN OBJET DE TYPE "LISTREEL".
  12. *
  13. * MODE D'APPEL:
  14. * -------------
  15. *
  16. *     CALL REMPL1 (IPOINT,IEME,REELDP)
  17. *
  18. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE
  19. * -----------
  20. *
  21. *     IPOINT  ENTIER    (E)  POINTEUR DE L'OBJET DE TYPE "LISTREEL".
  22. *     IEME    ENTIER    (E)  NUMERO D'ORDRE DE L'ELEMENT A REMPLACER
  23. *                            DANS L'OBJET DE TYPE "LISTREEL".
  24. *     REELDP  REEL DP   (E)  ELEMENT REMPLACANT.
  25. *     IPLISR  ENTIER    (E)  POINTEUR VERS UN "LISTREEL" DE REMPLACANTS
  26. *     IPOS    ENTIER    (E)  SI NEGATIF, IEME EST UN POINTEUR "LISTENTI"
  27. *
  28. * SOUS-PROGRAMMES APPELES:
  29. * ------------------------
  30. *
  31. *     ERREUR
  32. *
  33. * AUTEUR, DATE DE CREATION:
  34. * -------------------------
  35. *
  36. *     PASCAL MANIGOT     6 DECEMBRE 1984
  37. *
  38. * LANGAGE:
  39. * --------
  40. *
  41. *     ESOPE + FORTRAN77
  42. *
  43. ************************************************************************
  44. *
  45.       IMPLICIT INTEGER(I-N)
  46.  
  47. -INC PPARAM
  48. -INC CCOPTIO
  49. -INC SMLENTI
  50. -INC SMLREEL
  51. *
  52.       REAL*8 REELDP
  53. *
  54.       MLREEL=IPOINT
  55.       SEGACT,MLREEL*MOD
  56. *
  57. *     Y a-t-il plusieurs remplacements a faire ?
  58.       NBRMPL=1
  59.       IF (IPOS.LT.0) THEN
  60.           MLENT1=IEME
  61.           SEGACT,MLENT1
  62.           NBRMPL=MLENT1.LECT(/1)
  63. *
  64. *         Y a-t-il des valeurs de remplacement distinctes ?
  65.           IF (IPLISR.NE.0) THEN
  66.               MLREE1=IPLISR
  67.               SEGACT,MLREE1
  68.               IF (MLREE1.PROG(/1).NE.NBRMPL) THEN
  69.                   MOTERR(1:8)='LISTxxxx'
  70.                   CALL ERREUR(1015)
  71.                   RETURN
  72.               ENDIF
  73.           ENDIF
  74.       ENDIF
  75. *
  76. *     Mise a jour du LISTREEL
  77.       DO II=1,NBRMPL
  78.           IF (IPOS.LT.0) IEME=MLENT1.LECT(II)
  79.           IF (IPLISR.NE.0) REELDP=MLREE1.PROG(II)
  80.           IF (0.LT.IEME.AND.IEME.LE.PROG(/1)) THEN
  81.               PROG(IEME)=REELDP
  82.           ELSE
  83.               INTERR(1)=IEME
  84.               CALL ERREUR(36)
  85.           ENDIF
  86.       ENDDO
  87. *
  88.       SEGDES,MLREEL
  89.       IF (IPOS.LT.0) SEGDES,MLENT1
  90.       IF (IPLISR.NE.0) SEGDES,MLREE1
  91. *
  92.       END
  93.  
  94.  
  95.  
  96.  

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