Télécharger la plaquette Cast3M


fr en

Télécharger cotraj.eso

Retour à la liste

Numérotation des lignes : 

cotraj

  1. C COTRAJ    SOURCE    PV        17/12/08    21:17:02     9660           
  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.  
  94.  

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