Télécharger la plaquette Cast3M


fr en

Télécharger cotrai.eso

Retour à la liste

Numérotation des lignes : 

cotrai

  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