Télécharger cotra2.eso

Retour à la liste

Numérotation des lignes :

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

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