Télécharger la plaquette Cast3M


fr en

Télécharger cotrab.eso

Retour à la liste

Numérotation des lignes : 

cotrab

  1. C COTRAB    SOURCE    FANDEUR   09/09/23    21:15:05     6374
  2.  
  3.       SUBROUTINE COTRAB(IMAT,TRAC,LTRAC,IPOS,NSUP,NPOINT,KERRE)
  4.  
  5. C-----------------------------------------------------------------
  6. C
  7. C     RECUPERATION DE COURBE (RELATIVEMENT GENERAL)
  8. C
  9. C     IPOS   : DEBUT DE STOCKAGE DE LA COURBE DANS TRAC
  10. C     NSUP   : NOMBRE DE POINTS A SUPPRIMER
  11. C     NPOINT : NOMBRE DE POINTS STOCKES
  12. C
  13. C-----------------------------------------------------------------
  14.       IMPLICIT INTEGER(I-N)
  15.       IMPLICIT REAL*8(A-H,O-Z)
  16.  
  17. -INC SMEVOLL
  18. -INC SMLREEL
  19.  
  20.       DIMENSION TRAC(LTRAC)
  21.  
  22.       KERRE=0
  23. *
  24.       MEVOLL=IMAT
  25.       IF (MEVOLL.EQ.0) THEN
  26.         KERRE=354
  27.         RETURN
  28.       ENDIF
  29.       SEGACT,MEVOLL
  30.       IF (IEVOLL(/1).NE.1) THEN
  31. C*//    SEGDES,MEVOLL
  32.         KERRE=271
  33.         RETURN
  34.       ENDIF
  35. *
  36. *     COURBE (SELON Y)
  37. *
  38.       KEVOLL=IEVOLL(1)
  39. C*//  SEGDES,MEVOLL
  40. *
  41.       SEGACT,KEVOLL
  42.       MLREEL=IPROGX
  43.       MLREE1=IPROGY
  44. C*//  SEGDES,KEVOLL
  45. *
  46.       SEGACT,MLREEL,MLREE1
  47.       NBPOIX=PROG(/1)
  48.       IF (NBPOIX.NE.MLREE1.PROG(/1)) KERRE=271
  49.       NPOINT=2*(NBPOIX-NSUP)
  50.       IF (NPOINT.LE.0) KERRE=271
  51.       IF (NPOINT.GT.LTRAC-IPOS+1) KERRE=271
  52.       IF (KERRE.NE.0) GOTO 999
  53. *
  54.       IF (NSUP.GT.0) THEN
  55.         PSUP=PROG(NSUP+1)
  56.       ELSE
  57.         PSUP=0.D0
  58.       ENDIF
  59. *
  60.       NCOUR=IPOS
  61.       DO 10 I=NSUP+1,NBPOIX
  62.         TRAC(NCOUR  ) = PROG(I)-PSUP
  63.         TRAC(NCOUR+1) = MLREE1.PROG(I)
  64.         NCOUR=NCOUR+2
  65.   10  CONTINUE
  66. C
  67.  999  CONTINUE
  68. C*//  SEGDES,MLREEL,MLREE1
  69.  
  70.       RETURN
  71.       END
  72.  
  73.  
  74.  

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