Télécharger modico.eso

Retour à la liste

Numérotation des lignes :

  1. C MODICO SOURCE CB215821 16/04/21 21:17:47 8920
  2. SUBROUTINE MODICO(IPOI1,IEV1,ISOUS,ICOMP,IGA,IDR,
  3. * IEVG,IEVD,XVA,IVA,IEV)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. -INC SMCHAML
  7. -INC CCOPTIO
  8. -INC SMEVOLL
  9. -INC SMLREEL
  10. -INC SMNUAGE
  11. POINTEUR MLREE4.MLREEL
  12. MCHEL1=IPOI1
  13. MCHAM1=MCHEL1.ICHAML(ISOUS)
  14. MELVA1=MCHAM1.IELVAL(ICOMP)
  15. MNUAGE=MELVA1.IELCHE(1,1)
  16. NVFLO=0
  17. IA1=0
  18. IA2=0
  19. DO 203 INO=1,NUANOM(/2)
  20. IF (NUATYP(INO).EQ.'FLOTTANT')THEN
  21. IF (NVFLO.EQ.0)THEN
  22. IA1=INO
  23. ENDIF
  24. IF (NVFLO.EQ.1)THEN
  25. IA2=INO
  26. ENDIF
  27. NVFLO=NVFLO+1
  28. ENDIF
  29. 203 CONTINUE
  30. DO 204 IB=1,NUANOM(/2)
  31. IF (NUATYP(IB).EQ.'EVOLUTIO') GOTO 205
  32. 204 CONTINUE
  33. 205 NUAVFL=NUAPOI(IA1)
  34. IF (NVFLO.EQ.2.AND.IVA.EQ.2) THEN
  35. NUAVF1=NUAPOI(IA2)
  36. ENDIF
  37. NUAVIN=NUAPOI(IB)
  38. C
  39. MEVOL1=IEVG
  40. MEVOL2=IEVD
  41. SEGACT MEVOL1,MEVOL2
  42. KEVOL1=MEVOL1.IEVOLL(1)
  43. KEVOL2=MEVOL2.IEVOLL(1)
  44. SEGACT KEVOL1,KEVOL2
  45. MLREEL=KEVOL1.IPROGX
  46. MLREE1=KEVOL1.IPROGY
  47. MLREE2=KEVOL2.IPROGX
  48. MLREE3=KEVOL2.IPROGY
  49. SEGACT MLREEL,MLREE1,MLREE2,MLREE3
  50. XX=PROG(2)-MLREE2.PROG(2)
  51. YOGA=MLREE1.PROG(2)/PROG(2)
  52. YODR=MLREE3.PROG(2)/MLREE2.PROG(2)
  53. C
  54. C interpolation linéaire de module d'YOUNG
  55. C et de la contrainte de limite élastique
  56. C
  57. IF (IVA.EQ.1)THEN
  58. YOU1=(YOGA-YODR)/(NUAFLO(IGA)-NUAFLO(IDR))*
  59. & (XVA-NUAFLO(IDR))+YODR
  60. SIGY=(MLREE1.PROG(2)-MLREE3.PROG(2))/
  61. & (NUAFLO(IGA)-NUAFLO(IDR))*
  62. & (XVA-NUAFLO(IDR))+MLREE3.PROG(2)
  63. ENDIF
  64. IF (IVA.EQ.2)THEN
  65. YOU1=(YOGA-YODR)/(NUAVF1.NUAFLO(IGA)-NUAVF1.NUAFLO(IDR))*
  66. & (XVA-NUAVF1.NUAFLO(IDR))+YODR
  67. SIGY=(MLREE1.PROG(2)-MLREE3.PROG(2))/
  68. & (NUAVF1.NUAFLO(IGA)-NUAVF1.NUAFLO(IDR))*
  69. & (XVA-NUAVF1.NUAFLO(IDR))+MLREE3.PROG(2)
  70. ENDIF
  71. C
  72. SEGDES MEVOL1,MEVOL2,KEVOL1,KEVOL2
  73. SEGDES MLREEL,MLREE1,MLREE2,MLREE3
  74. C
  75. MEVOL1=IEV1
  76. SEGINI,MEVOLL=MEVOL1
  77. IEV=MEVOLL
  78. KEVOL1=IEVOLL(1)
  79. SEGINI,KEVOLL=KEVOL1
  80. IEVOLL(1)=KEVOLL
  81. MLREE1=IPROGX
  82. MLREE2=IPROGY
  83. SEGINI,MLREE3=MLREE1
  84. IPROGX=MLREE3
  85. SEGINI,MLREE4=MLREE2
  86. IPROGY=MLREE4
  87. YOU2=MLREE4.PROG(2)/MLREE3.PROG(2)
  88. C On teste le module d'Young
  89. TEST2=ABS((YOU2 - YOU1)/YOU2)
  90. IF (TEST2.GT.1.D-10) THEN
  91. IEV=0
  92. INTERR(1)=IEV1
  93. MOTERR(1:30)='est mal interpolé. Voir MODICO'
  94. CALL ERREUR(633)
  95. GOTO 1
  96. ENDIF
  97. C On modifie la courbe de traction : le point 2 sur
  98. C la courbe est le point d'intersection de 2 droite
  99. IF (MLREE3.PROG(/1).GT.3) THEN
  100. X1=MLREE3.PROG(3)
  101. X2=MLREE3.PROG(4)
  102. Y1=MLREE4.PROG(3)
  103. Y2=MLREE4.PROG(4)
  104. IF (ABS(XX).GT.1.D-20) THEN
  105. XK2=(Y1-Y2)/(X1-X2)
  106. X2NEW=(XK2*X1-Y1)/(XK2-YOU1)
  107. Y2NEW=YOU1*X2NEW
  108. MLREE3.PROG(2)=X2NEW
  109. MLREE4.PROG(2)=Y2NEW
  110. C write(6,*) 'K : ',XK2
  111. C write(6,*) 'X1 : ',X1
  112. C write(6,*) 'E : ',YOU1
  113. C write(6,*) 'Y1 : ',Y1
  114. C write(6,*) 'e_new : ',X2new
  115. C write(6,*) 'Y_new : ',Y2NEW
  116. C write(6,*) ' '
  117. C write(6,*) '----------------------------------------'
  118. ENDIF
  119. ENDIF
  120. 1 SEGDES MLREE3,MLREE4,KEVOLL,MEVOLL
  121. RETURN
  122. END
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  

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