Télécharger la plaquette Cast3M


fr en

Télécharger ccotr2.eso

Retour à la liste

Numérotation des lignes : 

ccotr2

  1. C CCOTR2    SOURCE    OF166741  25/09/30    21:15:01     12371          
  2.  
  3.       SUBROUTINE CCOTR2(WRK52,WRK53,WRK2,NCOURB)
  4.  
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8(A-H,O-Z)
  7.  
  8. -INC SMEVOLL
  9. -INC SMLREEL
  10. -INC DECHE
  11.  
  12.       SEGMENT/WRK2/(TRAC(LTRAC)*D)
  13. *
  14. *     QUELQUES INITIALISATIONS A 0
  15. *
  16.       KERRE=0
  17.  
  18.       NCOURB=0
  19.  
  20.       LTRAC = wrk2.TRAC(/1)
  21.       CALL ZDANUL(TRAC,LTRAC)
  22. *
  23. *     LOIS MOMENT-COURBURE ...
  24. *
  25.       MEVOLL = nint(XMAT(5))
  26.       IF (MEVOLL.EQ.0) THEN
  27.         KERRE=37
  28.         RETURN
  29.       ENDIF
  30.  
  31.       SEGACT,MEVOLL
  32.       JOJO = mevoll.IEVOLL(/1)
  33.       IF (JOJO.NE.1.AND.JOJO.NE.2) THEN
  34.         KERRE=31
  35.         GOTO 777
  36.       ENDIF
  37. *
  38. *     PREMIERE COURBE  ( SELON Y )
  39. *
  40.       DO IJO = 1, 2
  41.         IF (JOJO.EQ.1) KEVOLL=mevoll.IEVOLL(1)
  42.         IF (JOJO.EQ.2) KEVOLL=mevoll.IEVOLL(IJO)
  43.         SEGACT,KEVOLL
  44.         MLREEL = kevoll.IPROGX
  45.         MLREE1 = kevoll.IPROGY
  46.         SEGDES,KEVOLL
  47.         SEGACT,MLREEL,MLREE1
  48.         NBPOIX = mlreel.PROG(/1)
  49.         NBPOIY = mlree1.PROG(/1)
  50.         IF (NBPOIX.NE.NBPOIY) THEN
  51.           KERRE=31
  52.         ELSE IF (NBPOIX.GT.9) THEN
  53.           KERRE=31
  54.         ELSE IF (NBPOIX.LT.5) THEN
  55.           KERRE=32
  56.         ENDIF
  57. *   ERREUR
  58.         IF (KERRE.NE.0) THEN
  59.           SEGDES,MLREEL,MLREE1
  60.           GOTO 777
  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.       ENDDO
  72.  
  73.  777  CONTINUE
  74.       SEGDES,MEVOLL
  75.  
  76.       RETURN
  77.       END
  78.  
  79.  
  80.  

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