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.  
  43. -INC PPARAM
  44. -INC CCOPTIO
  45. *
  46. SEGMENT WRK0
  47. REAL*8 XMAT(NCXMAT)
  48. ENDSEGMENT
  49. *
  50. SEGMENT WR12
  51. REAL*8 EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3))
  52. REAL*8 EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6))
  53. REAL*8 EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9))
  54. REAL*8 SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS)
  55. REAL*8 SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS)
  56. REAL*8 SM8(NSTRS)
  57. ENDSEGMENT
  58. *
  59. DIMENSION NWA(9)
  60. CHARACTER*8 CMATE
  61. *
  62. ******* Cas d'une formulation isotrope
  63. *
  64. IF(CMATE.EQ.'ISOTROPE') THEN
  65.  
  66. *
  67. JED=0
  68. IF (IFOUR.EQ.-2) JED=1
  69. *
  70. * test sur la branche
  71. *
  72. IF (NBR.EQ.0) THEN
  73. CALL MAXINT(EM0,NWA(1),TPS1,FTPS1,IRET1)
  74. CALL MAXINT(EM0,NWA(1),TPS2,FTPS2,IRET2)
  75. EFIC=(FTPS2+FTPS1)/2
  76. TR=0.
  77. E1=FTPS1
  78. E2=FTPS2
  79. GOTO 10
  80. ELSE IF (NBR.EQ.1) THEN
  81. CALL MAXINT(EM1,NWA(2),TPS1,FTPS1,IRET1)
  82. CALL MAXINT(EM1,NWA(2),TPS2,FTPS2,IRET2)
  83. TR=XMAT(5)
  84. ELSE IF (NBR.EQ.2) THEN
  85. CALL MAXINT(EM2,NWA(3),TPS1,FTPS1,IRET1)
  86. CALL MAXINT(EM2,NWA(3),TPS2,FTPS2,IRET2)
  87. TR=XMAT(7)
  88. ELSE IF (NBR.EQ.3) THEN
  89. CALL MAXINT(EM3,NWA(4),TPS1,FTPS1,IRET1)
  90. CALL MAXINT(EM3,NWA(4),TPS2,FTPS2,IRET2)
  91. TR=XMAT(9)
  92. ELSE IF (NBR.EQ.4) THEN
  93. CALL MAXINT(EM4,NWA(5),TPS1,FTPS1,IRET1)
  94. CALL MAXINT(EM4,NWA(5),TPS2,FTPS2,IRET2)
  95. TR=XMAT(11)
  96. *
  97. * 5 et plus
  98. *
  99. ELSE IF (NBR.EQ.5) THEN
  100. CALL MAXINT(EM5,NWA(6),TPS1,FTPS1,IRET1)
  101. CALL MAXINT(EM5,NWA(6),TPS2,FTPS2,IRET2)
  102. TR=XMAT(15+JED)
  103. ELSE IF (NBR.EQ.6) THEN
  104. CALL MAXINT(EM6,NWA(7),TPS1,FTPS1,IRET1)
  105. CALL MAXINT(EM6,NWA(7),TPS2,FTPS2,IRET2)
  106. TR=XMAT(17+JED)
  107. ELSE IF (NBR.EQ.7) THEN
  108. CALL MAXINT(EM7,NWA(8),TPS1,FTPS1,IRET1)
  109. CALL MAXINT(EM7,NWA(8),TPS2,FTPS2,IRET2)
  110. TR=XMAT(19+JED)
  111. ELSE IF (NBR.EQ.8) THEN
  112. CALL MAXINT(EM8,NWA(9),TPS1,FTPS1,IRET1)
  113. CALL MAXINT(EM8,NWA(9),TPS2,FTPS2,IRET2)
  114. TR=XMAT(21+JED)
  115. ENDIF
  116. *
  117. ******* Cas d'une formulation unidirectionnelle
  118. *
  119. ELSE IF(CMATE.EQ.'UNIDIREC') THEN
  120.  
  121. *
  122. JED=0
  123. IF (IFOUR.EQ.-2) JED=1
  124. IF (IFOUR.EQ. 2) JED=4
  125. *
  126. KED=0
  127. IF (IFOUR.EQ. 2) KED=4
  128.  
  129. * test sur la branche
  130. *
  131. IF (NBR.EQ.0) THEN
  132. CALL MAXINT(EM0,NWA(1),TPS1,FTPS1,IRET1)
  133. CALL MAXINT(EM0,NWA(1),TPS2,FTPS2,IRET2)
  134. EFIC=(FTPS2+FTPS1)/2
  135. TR=0.
  136. E1=FTPS1
  137. E2=FTPS2
  138. GOTO 10
  139. ELSE IF (NBR.EQ.1) THEN
  140. CALL MAXINT(EM1,NWA(2),TPS1,FTPS1,IRET1)
  141. CALL MAXINT(EM1,NWA(2),TPS2,FTPS2,IRET2)
  142. TR=XMAT(6+KED)
  143. ELSE IF (NBR.EQ.2) THEN
  144. CALL MAXINT(EM2,NWA(3),TPS1,FTPS1,IRET1)
  145. CALL MAXINT(EM2,NWA(3),TPS2,FTPS2,IRET2)
  146. TR=XMAT(8+KED)
  147. ELSE IF (NBR.EQ.3) THEN
  148. CALL MAXINT(EM3,NWA(4),TPS1,FTPS1,IRET1)
  149. CALL MAXINT(EM3,NWA(4),TPS2,FTPS2,IRET2)
  150. TR=XMAT(10+KED)
  151. ELSE IF (NBR.EQ.4) THEN
  152. CALL MAXINT(EM4,NWA(5),TPS1,FTPS1,IRET1)
  153. CALL MAXINT(EM4,NWA(5),TPS2,FTPS2,IRET2)
  154. TR=XMAT(12+KED)
  155. *
  156. * 5 et plus
  157. *
  158. ELSE IF (NBR.EQ.5) THEN
  159. CALL MAXINT(EM5,NWA(6),TPS1,FTPS1,IRET1)
  160. CALL MAXINT(EM5,NWA(6),TPS2,FTPS2,IRET2)
  161. TR=XMAT(16+JED)
  162. ELSE IF (NBR.EQ.6) THEN
  163. CALL MAXINT(EM6,NWA(7),TPS1,FTPS1,IRET1)
  164. CALL MAXINT(EM6,NWA(7),TPS2,FTPS2,IRET2)
  165. TR=XMAT(18+JED)
  166. ELSE IF (NBR.EQ.7) THEN
  167. CALL MAXINT(EM7,NWA(8),TPS1,FTPS1,IRET1)
  168. CALL MAXINT(EM7,NWA(8),TPS2,FTPS2,IRET2)
  169. TR=XMAT(20+JED)
  170. ELSE IF (NBR.EQ.8) THEN
  171. CALL MAXINT(EM8,NWA(9),TPS1,FTPS1,IRET1)
  172. CALL MAXINT(EM8,NWA(9),TPS2,FTPS2,IRET2)
  173. TR=XMAT(22+JED)
  174. ENDIF
  175. ENDIF
  176. *
  177. *
  178. E1=FTPS1
  179. E2=FTPS2
  180. IF(TPS2-TPS1.EQ.0.D0) THEN
  181. EFIC =FTPS1
  182. ELSE
  183. EFIC=1.D0/(TR*(TPS2-TPS1))*
  184. 1 ((FTPS1*(1.D0-EXP(-TR*(TPS2-TPS1))))
  185. 2 +(FTPS2-FTPS1)*(1.D0-(1.D0-EXP(-TR*(TPS2-TPS1)))/
  186. 3 (TR*(TPS2-TPS1))))
  187. ENDIF
  188. *
  189. *
  190. 10 IF (IRET1.EQ.0) THEN
  191. CALL ERREUR(854)
  192. RETURN
  193. ELSE IF (IRET2.EQ.0) THEN
  194. CALL ERREUR(854)
  195. RETURN
  196. ENDIF
  197. END
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  

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