Télécharger la plaquette Cast3M


fr en

Télécharger cotrae.eso

Retour à la liste

Numérotation des lignes : 

cotrae

  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