Télécharger la plaquette Cast3M


fr en

Télécharger cotrad.eso

Retour à la liste

Numérotation des lignes : 

cotrad

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

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