Télécharger la plaquette Cast3M


fr en

Télécharger cotraf.eso

Retour à la liste

Numérotation des lignes : 

cotraf

  1. C COTRAF    SOURCE    OF166741  25/09/30    21:15:12     12371          
  2.  
  3.       SUBROUTINE COTRAF(wrk52,wrk53,WRK2,NCOURB)
  4. C-----------------------------------------------------------------
  5. C
  6. C     RECUPERAGE DE COURBE ADAPTE A TAKEDA
  7. C
  8. C     PP 18/9/92
  9. C-----------------------------------------------------------------
  10.       IMPLICIT INTEGER(I-N)
  11.       IMPLICIT REAL*8(A-H,O-Z)
  12. -INC SMEVOLL
  13. -INC SMLREEL
  14. -INC DECHE
  15.  
  16.       SEGMENT WRK2
  17.         REAL*8 TRAC(LTRAC)
  18.       ENDSEGMENT
  19. *
  20. *     QUELQUES INITIALISATIONS A 0
  21. *
  22.       KERRE=0
  23.       NCOURB=0
  24.       LTRAC=TRAC(/1)
  25.       CALL ZDANUL(TRAC,LTRAC)
  26. *
  27. *     LOIS MOMENT-COURBURE ...
  28. *
  29.       MEVOLL=NINT(XMAT(5))
  30.       IF(MEVOLL.EQ.0) THEN
  31.         KERRE=37
  32.         RETURN
  33.       ENDIF
  34.       SEGACT MEVOLL
  35.       IF (IEVOLL(/1).NE.1) THEN
  36.         KERRE=31
  37.         SEGDES MEVOLL
  38.         RETURN
  39.       ENDIF
  40. *
  41. *     COURBE  ( SELON Y )
  42. *
  43.       KEVOLL = IEVOLL(1)
  44.       SEGDES,MEVOLL
  45.       SEGACT,KEVOLL
  46.       MLREEL=IPROGX
  47.       MLREE1=IPROGY
  48.       SEGDES,KEVOLL
  49.       SEGACT,MLREEL,MLREE1
  50.       NBPOIX=mlreel.PROG(/1)
  51.       NBPOIY=MLREE1.PROG(/1)
  52. *
  53. *   ERREUR
  54. *
  55.       IF (NBPOIX.NE.NBPOIY) KERRE=31
  56.       IF (NBPOIX.GT.7) KERRE=31
  57.       IF (NBPOIX.LT.4) KERRE=32
  58.       IF (KERRE.NE.0) THEN
  59.         SEGDES MLREEL,MLREE1
  60.         RETURN
  61.       ENDIF
  62.  
  63.       DO I = 1, NBPOIX
  64.         NCOURB=NCOURB+1
  65.         TRAC(2*NCOURB-1) = MLREE1.PROG(I)
  66.         TRAC(2*NCOURB)   = mlreel.PROG(I)
  67.       ENDDO
  68.  
  69.       SEGDES MLREEL,MLREE1
  70.  
  71.       RETURN
  72.       END
  73.  
  74.  
  75.  

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