Télécharger cotraj.eso

Retour à la liste

Numérotation des lignes :

  1. C COTRAJ SOURCE BP208322 17/03/01 21:16:40 9325
  2. C COTRAI SOURCE AM 95/12/27 21:25:29 1962
  3. SUBROUTINE COTRAJ(wrk52,wrk53,WRK2,NUCO,IPOS,NSUP,NPOINT)
  4. C-----------------------------------------------------------------
  5. C
  6. C RECUPERAGE DE COURBE (RELATIVEMENT GENERAL)
  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. -INC DECHE
  19. SEGMENT WRK2
  20. REAL*8 TRAC(LTRAC)
  21. ENDSEGMENT
  22. *
  23. * QUELQUES INITIALISATIONS A 0
  24. *
  25. KERRE=0
  26. NCOURB=0
  27. LTRAC=TRAC(/1)
  28. CALL ZDANUL(TRAC(IPOS),LTRAC-IPOS+1)
  29. *
  30. * LOIS
  31. *
  32. MEVOLL=nint(XMAT(NUCO))
  33. IF(MEVOLL.EQ.0) THEN
  34. KERRE=37
  35. RETURN
  36. ENDIF
  37. SEGACT MEVOLL
  38. IF(IEVOLL(/1).NE.1) THEN
  39. KERRE=31
  40. SEGDES MEVOLL
  41. RETURN
  42. ENDIF
  43. *
  44. * COURBE ( SELON Y )
  45. *
  46. KEVOLL=IEVOLL(1)
  47. SEGACT KEVOLL
  48. MLREEL=IPROGX
  49. MLREE1=IPROGY
  50. SEGDES KEVOLL
  51. SEGACT MLREEL,MLREE1
  52. NBPOIX=PROG(/1)
  53. NBPOIY=MLREE1.PROG(/1)
  54. IF(NBPOIX.NE.NBPOIY) KERRE=31
  55. IF(2*(NBPOIX-NSUP).GT.LTRAC-IPOS+1) KERRE=31
  56. *
  57. * ERREUR
  58. *
  59. IF(KERRE.NE.0) THEN
  60. SEGDES MLREEL,MLREE1
  61. SEGDES MEVOLL
  62. RETURN
  63. ENDIF
  64. *
  65. IF(NSUP.GT.0)THEN
  66. PSUP=PROG(NSUP+1)
  67. ELSE
  68. PSUP=0.D0
  69. ENDIF
  70. DO 10 I=NSUP+1,NBPOIX
  71. PEPS=PROG(I)-PSUP
  72. PSIG=MLREE1.PROG(I)
  73. NCOURB=NCOURB+1
  74. TRAC(IPOS+2*NCOURB-2)=PEPS
  75. TRAC(IPOS+2*NCOURB-1)=PSIG
  76. 10 CONTINUE
  77. NPOINT=2*NCOURB
  78. C
  79. SEGDES MLREEL,MLREE1
  80. SEGDES MEVOLL
  81. RETURN
  82. END
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  

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