Télécharger modfic.eso

Retour à la liste

Numérotation des lignes :

  1. C MODFIC SOURCE CHAT 05/01/13 01:49:20 5004
  2. SUBROUTINE MODFIC(TPS1,TPS2,NBR,WR12,WRK0,NWA,
  3. 1 EFIC,TR,E1,E2,KERRE,CMATE)
  4. *
  5. *
  6. *==============================================================
  7. * calcul du module fictif d'une chaine de Maxwell
  8. *==============================================================
  9. *
  10. *
  11. * entrees
  12. *
  13. * WRK0
  14. * XMAT(NCOMAT) = CARACTERISTIQUES MECANIQUES DU MATERIAU
  15. *
  16. * WRK12
  17. * EMi(2,NWA(i+1)) i=0 a 8
  18. * = EVOLUTION DU MODUE D'YOUNG DE LA BRANCHE i
  19. * SMi(NSTRS) i=1 a 8
  20. * = VARIABLES INTERNES AU DEBUT DU PAS D'INTEGRATION
  21. *
  22. * TPS1 = TEMPS AU DEBUT DU PAS D'INTEGRATION
  23. * TPS2 = TEMPS A LA FIN DU PAS D'INTEGRATION
  24. * NBR = INDICE DE LA CHAINE DE MAXWELL CONCERNEE
  25. * NWA = TABLEAU DES DIMENSIONS DES EVOLUTIONS DES MODULES DE CHAQUE CHAINE
  26. *
  27. *
  28. * sortie
  29. *
  30. * EFIC = MODULE FICTIF DE LA CHAINE DE MAXWELL
  31. * TR = TEMPS DE RELAXATION DE LA CHAINE DE MAXWELL
  32. * E1 = MODULE DE LA CHAINE DE MAXWELL AU DEBUT DU PAS
  33. * E2 = MODULE DE LA CHAINE DE MAXWELL A LA FIN DU PAS
  34. * KERRE = INDICATEUR D'ERREUR
  35. *
  36. *
  37. *
  38. *==============================================================
  39. *
  40. IMPLICIT INTEGER(I-N)
  41. IMPLICIT REAL*8(A-H,O-Z)
  42. -INC CCOPTIO
  43. *
  44. SEGMENT WRK0
  45. REAL*8 XMAT(NCXMAT)
  46. ENDSEGMENT
  47. *
  48. SEGMENT WR12
  49. REAL*8 EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3))
  50. REAL*8 EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6))
  51. REAL*8 EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9))
  52. REAL*8 SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS)
  53. REAL*8 SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS)
  54. REAL*8 SM8(NSTRS)
  55. ENDSEGMENT
  56. *
  57. DIMENSION NWA(9)
  58. CHARACTER*8 CMATE
  59. *
  60. ******* Cas d'une formulation isotrope
  61. *
  62. IF(CMATE.EQ.'ISOTROPE') THEN
  63.  
  64. *
  65. JED=0
  66. IF (IFOUR.EQ.-2) JED=1
  67. *
  68. * test sur la branche
  69. *
  70. IF (NBR.EQ.0) THEN
  71. CALL MAXINT(EM0,NWA(1),TPS1,FTPS1,IRET1)
  72. CALL MAXINT(EM0,NWA(1),TPS2,FTPS2,IRET2)
  73. EFIC=(FTPS2+FTPS1)/2
  74. TR=0.
  75. E1=FTPS1
  76. E2=FTPS2
  77. GOTO 10
  78. ELSE IF (NBR.EQ.1) THEN
  79. CALL MAXINT(EM1,NWA(2),TPS1,FTPS1,IRET1)
  80. CALL MAXINT(EM1,NWA(2),TPS2,FTPS2,IRET2)
  81. TR=XMAT(5)
  82. ELSE IF (NBR.EQ.2) THEN
  83. CALL MAXINT(EM2,NWA(3),TPS1,FTPS1,IRET1)
  84. CALL MAXINT(EM2,NWA(3),TPS2,FTPS2,IRET2)
  85. TR=XMAT(7)
  86. ELSE IF (NBR.EQ.3) THEN
  87. CALL MAXINT(EM3,NWA(4),TPS1,FTPS1,IRET1)
  88. CALL MAXINT(EM3,NWA(4),TPS2,FTPS2,IRET2)
  89. TR=XMAT(9)
  90. ELSE IF (NBR.EQ.4) THEN
  91. CALL MAXINT(EM4,NWA(5),TPS1,FTPS1,IRET1)
  92. CALL MAXINT(EM4,NWA(5),TPS2,FTPS2,IRET2)
  93. TR=XMAT(11)
  94. *
  95. * 5 et plus
  96. *
  97. ELSE IF (NBR.EQ.5) THEN
  98. CALL MAXINT(EM5,NWA(6),TPS1,FTPS1,IRET1)
  99. CALL MAXINT(EM5,NWA(6),TPS2,FTPS2,IRET2)
  100. TR=XMAT(15+JED)
  101. ELSE IF (NBR.EQ.6) THEN
  102. CALL MAXINT(EM6,NWA(7),TPS1,FTPS1,IRET1)
  103. CALL MAXINT(EM6,NWA(7),TPS2,FTPS2,IRET2)
  104. TR=XMAT(17+JED)
  105. ELSE IF (NBR.EQ.7) THEN
  106. CALL MAXINT(EM7,NWA(8),TPS1,FTPS1,IRET1)
  107. CALL MAXINT(EM7,NWA(8),TPS2,FTPS2,IRET2)
  108. TR=XMAT(19+JED)
  109. ELSE IF (NBR.EQ.8) THEN
  110. CALL MAXINT(EM8,NWA(9),TPS1,FTPS1,IRET1)
  111. CALL MAXINT(EM8,NWA(9),TPS2,FTPS2,IRET2)
  112. TR=XMAT(21+JED)
  113. ENDIF
  114. *
  115. ******* Cas d'une formulation unidirectionnelle
  116. *
  117. ELSE IF(CMATE.EQ.'UNIDIREC') THEN
  118.  
  119. *
  120. JED=0
  121. IF (IFOUR.EQ.-2) JED=1
  122. IF (IFOUR.EQ. 2) JED=4
  123. *
  124. KED=0
  125. IF (IFOUR.EQ. 2) KED=4
  126.  
  127. * test sur la branche
  128. *
  129. IF (NBR.EQ.0) THEN
  130. CALL MAXINT(EM0,NWA(1),TPS1,FTPS1,IRET1)
  131. CALL MAXINT(EM0,NWA(1),TPS2,FTPS2,IRET2)
  132. EFIC=(FTPS2+FTPS1)/2
  133. TR=0.
  134. E1=FTPS1
  135. E2=FTPS2
  136. GOTO 10
  137. ELSE IF (NBR.EQ.1) THEN
  138. CALL MAXINT(EM1,NWA(2),TPS1,FTPS1,IRET1)
  139. CALL MAXINT(EM1,NWA(2),TPS2,FTPS2,IRET2)
  140. TR=XMAT(6+KED)
  141. ELSE IF (NBR.EQ.2) THEN
  142. CALL MAXINT(EM2,NWA(3),TPS1,FTPS1,IRET1)
  143. CALL MAXINT(EM2,NWA(3),TPS2,FTPS2,IRET2)
  144. TR=XMAT(8+KED)
  145. ELSE IF (NBR.EQ.3) THEN
  146. CALL MAXINT(EM3,NWA(4),TPS1,FTPS1,IRET1)
  147. CALL MAXINT(EM3,NWA(4),TPS2,FTPS2,IRET2)
  148. TR=XMAT(10+KED)
  149. ELSE IF (NBR.EQ.4) THEN
  150. CALL MAXINT(EM4,NWA(5),TPS1,FTPS1,IRET1)
  151. CALL MAXINT(EM4,NWA(5),TPS2,FTPS2,IRET2)
  152. TR=XMAT(12+KED)
  153. *
  154. * 5 et plus
  155. *
  156. ELSE IF (NBR.EQ.5) THEN
  157. CALL MAXINT(EM5,NWA(6),TPS1,FTPS1,IRET1)
  158. CALL MAXINT(EM5,NWA(6),TPS2,FTPS2,IRET2)
  159. TR=XMAT(16+JED)
  160. ELSE IF (NBR.EQ.6) THEN
  161. CALL MAXINT(EM6,NWA(7),TPS1,FTPS1,IRET1)
  162. CALL MAXINT(EM6,NWA(7),TPS2,FTPS2,IRET2)
  163. TR=XMAT(18+JED)
  164. ELSE IF (NBR.EQ.7) THEN
  165. CALL MAXINT(EM7,NWA(8),TPS1,FTPS1,IRET1)
  166. CALL MAXINT(EM7,NWA(8),TPS2,FTPS2,IRET2)
  167. TR=XMAT(20+JED)
  168. ELSE IF (NBR.EQ.8) THEN
  169. CALL MAXINT(EM8,NWA(9),TPS1,FTPS1,IRET1)
  170. CALL MAXINT(EM8,NWA(9),TPS2,FTPS2,IRET2)
  171. TR=XMAT(22+JED)
  172. ENDIF
  173. ENDIF
  174. *
  175. *
  176. E1=FTPS1
  177. E2=FTPS2
  178. IF(TPS2-TPS1.EQ.0.D0) THEN
  179. EFIC =FTPS1
  180. ELSE
  181. EFIC=1.D0/(TR*(TPS2-TPS1))*
  182. 1 ((FTPS1*(1.D0-EXP(-TR*(TPS2-TPS1))))
  183. 2 +(FTPS2-FTPS1)*(1.D0-(1.D0-EXP(-TR*(TPS2-TPS1)))/
  184. 3 (TR*(TPS2-TPS1))))
  185. ENDIF
  186. *
  187. *
  188. 10 IF (IRET1.EQ.0) THEN
  189. CALL ERREUR(854)
  190. RETURN
  191. ELSE IF (IRET2.EQ.0) THEN
  192. CALL ERREUR(854)
  193. RETURN
  194. ENDIF
  195. END
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  

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