Télécharger cotrab.eso

Retour à la liste

Numérotation des lignes :

  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