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    OF166741  25/09/30    21:15:12     12371          
  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.       NPOINT=0
  28.  
  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.         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,MEVOLL
  52.       SEGACT MLREEL,MLREE1
  53.       NBPOIX=PROG(/1)
  54.       NBPOIY=MLREE1.PROG(/1)
  55. *
  56. *   ERREUR
  57. *
  58.       IF(NBPOIX.NE.NBPOIY) KERRE=31
  59.       IF(2*(NBPOIX-NSUP).GT.LTRAC-IPOS+1) KERRE=31
  60.       IF (KERRE.NE.0) RETURN
  61. *
  62.       IF (NSUP.GT.0)THEN
  63.         PSUP= mlreel.PROG(NSUP+1)
  64.       ELSE
  65.         PSUP=0.D0
  66.       ENDIF
  67.       NCOURB=0
  68.       DO I=NSUP+1,NBPOIX
  69.         NCOURB=NCOURB+1
  70.         TRAC(IPOS+2*NCOURB-2)= MLREEL.PROG(I)-PSUP
  71.         TRAC(IPOS+2*NCOURB-1)= MLREE1.PROG(I)
  72.       ENDDO
  73.  
  74.       NPOINT=2*NCOURB
  75. C
  76.       SEGDES MLREEL,MLREE1
  77.  
  78.       RETURN
  79.       END
  80.  
  81.  
  82.  

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