Télécharger la plaquette Cast3M


fr en

Télécharger cotra2.eso

Retour à la liste

Numérotation des lignes : 

cotra2

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

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