Télécharger cotrai.eso

Retour à la liste

Numérotation des lignes :

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

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