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    OF166741  25/09/30    21:15:11     12371          
  2.  
  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 POINTS A SUPPRIMER
  11. C     NPOINT : NOMBRE DE POINTS STOCKES
  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.       NPOINT = 0
  29.  
  30.       LTRAC=TRAC(/1)
  31.       CALL ZDANUL(TRAC(IPOS),LTRAC-IPOS+1)
  32. *
  33. *  LOIS
  34. *
  35.       MEVOLL=NINT(XMAT(NUCO))
  36.       IF(MEVOLL.EQ.0) THEN
  37.         KERRE=37
  38.         RETURN
  39.       ENDIF
  40.       SEGACT MEVOLL
  41.       IF (IEVOLL(/1).NE.1) THEN
  42.         KERRE=31
  43.         RETURN
  44.       ENDIF
  45. *
  46. *  COURBE ( SELON Y )
  47. *
  48.       KEVOLL = IEVOLL(1)
  49.       SEGDES,MEVOLL
  50.       SEGACT,KEVOLL
  51.       MLREEL=IPROGX
  52.       MLREE1=IPROGY
  53.       SEGDES,KEVOLL
  54.       SEGACT,MLREEL,MLREE1
  55.       NBPOIX=mlreel.PROG(/1)
  56.       NBPOIY=MLREE1.PROG(/1)
  57. *
  58. *  ERREUR(S)
  59. *
  60.       IF (NBPOIX.NE.NBPOIY) KERRE=31
  61.       IF (2*(NBPOIX-NSUP).GT.LTRAC-IPOS+1) KERRE=31
  62.       IF (KERRE.NE.0) GOTO 999
  63.  
  64.       IF (NSUP.GT.0) THEN
  65.         PSUP=PROG(NSUP+1)
  66.       ELSE
  67.         PSUP=0.D0
  68.       ENDIF
  69.       NCOURB=0
  70.       DO I=NSUP+1,NBPOIX
  71.         NCOURB=NCOURB+1
  72.         TRAC(IPOS+2*NCOURB-2)= mlreel.PROG(I)-PSUP
  73.         TRAC(IPOS+2*NCOURB-1)= MLREE1.PROG(I)
  74.       ENDDO
  75.       NPOINT=2*NCOURB
  76.  
  77.  999  CONTINUE
  78.       SEGDES,MLREEL,MLREE1
  79.  
  80.       RETURN
  81.       END
  82.  
  83.  
  84.  

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