Télécharger cotrae.eso

Retour à la liste

Numérotation des lignes :

  1. C COTRAE SOURCE PV 11/03/07 21:16:02 6885
  2. C COTRAE
  3. SUBROUTINE COTRAE(WWRK0,WRK2,NUCO,IPOS,NSUP, NPOINT,KERRE)
  4. C-----------------------------------------------------------------
  5. C
  6. C RECUPERAGE DE COURBE (Pour le modele d'etage)
  7. C
  8. C NUCO : COMPOSANTE DE XMAT DONNANT L'EVOLUTION
  9. C IPOS : DEBUT DE STOCKAGE DE LA COURBE DANS TRAC
  10. C NSUP : NOMBRE DE POINT A SUPPRIMER
  11. C NPOINT : NOMBRE DE POINT STOCKE
  12. C
  13. C-----------------------------------------------------------------
  14. IMPLICIT INTEGER(I-N)
  15. IMPLICIT REAL*8(A-H,O-Z)
  16. -INC SMEVOLL
  17. -INC SMLREEL
  18. SEGMENT WWRK0
  19. REAL*8 XMAT(NCOMAT),XCAR(NCXCAR)
  20. ENDSEGMENT
  21. SEGMENT WRK2
  22. REAL*8 TRAC(LTRAC)
  23. ENDSEGMENT
  24. *
  25. * QUELQUES INITIALISATIONS A 0
  26. *
  27. KERRE=0
  28. NCOURB=0
  29. LTRAC=TRAC(/1)
  30. CALL ZDANUL(TRAC(IPOS),LTRAC-IPOS+1)
  31. *
  32. * LOIS
  33. *
  34. MEVOLL=nint(XMAT(NUCO))
  35. IF(MEVOLL.EQ.0) THEN
  36. KERRE=37
  37. RETURN
  38. ENDIF
  39. SEGACT MEVOLL
  40. IF(IEVOLL(/1).NE.1) THEN
  41. KERRE=31
  42. SEGDES MEVOLL
  43. RETURN
  44. ENDIF
  45. *
  46. * COURBE ( SELON Y )
  47. *
  48. KEVOLL=IEVOLL(1)
  49. SEGACT KEVOLL
  50. MLREEL=IPROGX
  51. MLREE1=IPROGY
  52. SEGDES KEVOLL
  53. SEGACT MLREEL,MLREE1
  54. NBPOIX=PROG(/1)
  55. NBPOIY=MLREE1.PROG(/1)
  56. IF(NBPOIX.NE.NBPOIY) KERRE=31
  57. IF(2*(NBPOIX-NSUP).GT.LTRAC-IPOS+1) KERRE=31
  58. *
  59. * ERREUR
  60. *
  61. IF(KERRE.NE.0) THEN
  62. SEGDES MLREEL,MLREE1
  63. SEGDES MEVOLL
  64. RETURN
  65. ENDIF
  66. *
  67. IF(NSUP.GT.0)THEN
  68. PSUP=PROG(NSUP+1)
  69. ELSE
  70. PSUP=0.D0
  71. ENDIF
  72. DO 10 I=NSUP+1,NBPOIX
  73. PEPS=PROG(I)-PSUP
  74. PSIG=MLREE1.PROG(I)
  75. NCOURB=NCOURB+1
  76. TRAC(IPOS+2*NCOURB-2)=PEPS
  77. TRAC(IPOS+2*NCOURB-1)=PSIG
  78. 10 CONTINUE
  79. NPOINT=2*NCOURB
  80. C
  81. SEGDES MLREEL,MLREE1
  82. SEGDES MEVOLL
  83. RETURN
  84. END
  85.  
  86.  
  87.  
  88.  
  89.  

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