Télécharger cfl2.eso

Retour à la liste

Numérotation des lignes :

  1. C CFL2 SOURCE BP208322 15/06/22 21:15:54 8543
  2. SUBROUTINE CFL2(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2)
  3. *---------------------------------------------------------------------*
  4. *
  5. * calcul du pas de temps CFL
  6. *
  7. * elements massifs formulation mécanique
  8. *
  9. *
  10. * entree
  11. * icas : cas à traiter
  12. * = 1 calcul du pas de temps complet ivam1 avec cara
  13. * = 2 calcul du pas de temps lorsque cson est donne ivam2
  14. * = 3 calcul du pas de temps lorsque la taille est donnée ivam1 si cara
  15. * = 4 calcul de la vitesse du son ivam1 donné
  16. * = 5 calcul du parametre de taille ivam1 si cara
  17. *
  18. * ipmail : pointeur vers le maillage a traiter
  19. * mele : numero de l'élément finis dans nomtp
  20. * ivam1 : pointeur vers mptval du cham1 actif
  21. * ivam2 : pointeur vers mptval du cham2 actif
  22. * n2 : nombre de comosante en sortie
  23. *
  24. * sortie
  25. * melv1 : melval de la première composante du chamelem resultat
  26. * inactif en sortie
  27. * melv2 : melval de la deuxième composante du chamelem resultat
  28. * inactif en sortie
  29. *
  30. *
  31. *---------------------------------------------------------------------*
  32. IMPLICIT INTEGER(I-N)
  33. IMPLICIT REAL*8(A-H,O-Z)
  34. *
  35. -INC CCOPTIO
  36. -INC CCHAMP
  37. -INC SMCHAML
  38. -INC SMELEME
  39. *
  40. *
  41. SEGMENT MPTVAL
  42. * ipos pointeur vers la sous zone du mchelm
  43. * nsof ??
  44. INTEGER IPOS(NS) ,NSOF(NS)
  45. * ival pointeur vers le melval de la composante
  46. * =0 si il n'est pas présente
  47. * ncosou = nbrfac + nbrobl
  48. INTEGER IVAL(NCOSOU)
  49. * continent le type de composante
  50. CHARACTER*16 TYVAL(NCOSOU)
  51. ENDSEGMENT
  52. POINTEUR MPTVA1.MPTVAL,MPTVA2.MPTVAL
  53. *
  54. *
  55. *
  56. MPTVA1 = IVAM1
  57. MPTVA2 = IVAM2
  58. *
  59. *
  60. * branchement en fonction de l'élément fini
  61. *
  62. * 0 5 0 5 0
  63. GOTO (99,99,99, 4,99,99,99, 4,99,99,99,99,99,99,99,99,99,99,99,99,
  64. 2 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  65. 4 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  66. 6 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  67. 8 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  68. 1 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  69. 2 99,99,99,99,99,99,99),MELE
  70. *
  71. * éléments massifs
  72. *
  73. 4 CONTINUE
  74. * ================ calcul de la vitesse du son
  75. * le resultat est stocké dans melval avec n1ptel =1
  76. IF (ICAS.EQ.1.OR.ICAS.EQ.3.OR.ICAS.EQ.4) THEN
  77. * recherche des paramètre matériau
  78. * module d'young
  79. MELVA3 = MPTVA1.IVAL(1)
  80. * densite
  81. MELVA4 = MPTVA1.IVAL(3)
  82. SEGDES MPTVA1
  83. SEGACT MELVA3,MELVA4
  84. *
  85. N1EL = MIN(MELVA3.VELCHE(/2),MELVA4.VELCHE(/2))
  86. N1PTEL = 1
  87. N2PTEL = 0
  88. N2EL = 0
  89. SEGINI MELVAL
  90. MCSON = MELVAL
  91. * boucle sur les éléments pour calculer la vitesse du son
  92. DO 403 I=1,N1EL
  93. * on prend les valeurs moyennes sur les éléments
  94. YOU1 = 0.D0
  95. I3 = MIN(I,MELVA3.VELCHE(/2))
  96. DO 401 J=1,MELVA3.VELCHE(/1)
  97. YOU1 = YOU1 + MELVA3.VELCHE(J,I3)
  98. 401 CONTINUE
  99. YOU1 = YOU1 / MELVA3.VELCHE(/1)
  100. *
  101. RO1 = 0.D0
  102. I4 = MIN(I,MELVA4.VELCHE(/2))
  103. DO 402 J=1,MELVA4.VELCHE(/1)
  104. RO1 = RO1 + MELVA4.VELCHE(J,I4)
  105. 402 CONTINUE
  106. RO1 = RO1 / MELVA4.VELCHE(/1)
  107. IF (RO1.EQ.0.D0) THEN
  108. SEGDES MELVA4,MELVA3
  109. SEGSUP MELVAL
  110. CALL ERREUR(855)
  111. RETURN
  112. ENDIF
  113. *
  114. IF (YOU1.EQ.0.D0) THEN
  115. SEGDES MELVA4,MELVA3
  116. SEGSUP MELVAL
  117. CALL ERREUR(856)
  118. RETURN
  119. ENDIF
  120. VELCHE(1,I) = SQRT(YOU1/RO1)
  121. * write(6,*) 'Element', i , 'Cson' , VELCHE(1,i)
  122. 403 CONTINUE
  123. SEGDES MELVA4,MELVA3
  124. IF (ICAS.EQ.4) THEN
  125. * cas ou seule la vitesse du son est demandée
  126. MELVA2 = 0
  127. MELV1 = MELVAL
  128. SEGDES MELVAL
  129. RETURN
  130. ENDIF
  131. ELSE IF (ICAS.EQ.2) THEN
  132. * recuperation du champ
  133. SEGACT MPTVA2
  134. MELVA1 = MPTVA2.IVAL(1)
  135. SEGACT MELVA1
  136. MCSON = MELVA1
  137. SEGDES MPTVA2
  138. ENDIF
  139. * ================ paramètre geometrique
  140. * stocké dans un melval mtaille
  141. IF (ICAS.EQ.1.OR.ICAS.EQ.2.OR.ICAS.EQ.5) THEN
  142. MELEME = IPMAIL
  143. SEGACT MELEME
  144. N1EL = NUM(/2)
  145. N1PTEL = 1
  146. N2PTEL = 0
  147. N2EL = 0
  148. SEGINI MELVAL
  149. MTAIL1 = MELVAL
  150. MTAIL2 = 0
  151. CALL CFLTAI(MTAIL1,IPMAIL,MELE)
  152. SEGDES MELEME
  153. IF (ICAS.EQ.5) THEN
  154. MELV1 = MTAIL1
  155. MELV2 = 0
  156. SEGDES MELVAL
  157. RETURN
  158. ENDIF
  159. ELSE IF (ICAS.EQ.3) THEN
  160. * recuperation du champ
  161. SEGACT MPTVA2
  162. MELVA1 = MPTVA2.IVAL(1)
  163. SEGACT MELVA1
  164. MTAIL1 = MELVA1
  165. SEGDES MPTVA2
  166. ENDIF
  167. * ================ pas de temps cfl
  168. IF (ICAS.EQ.1.OR.ICAS.EQ.2.OR.ICAS.EQ.3) THEN
  169. * recuperation de la vitesse du son
  170. * et du paramètre de taille
  171. MELVA1 = MCSON
  172. MELVA2 = MTAIL1
  173. * creation du melval résultat
  174. N1EL = MAX(MELVA1.VELCHE(/2),MELVA2.VELCHE(/2))
  175. N1PTEL = 1
  176. N2EL = 0
  177. N2PTEL = 0
  178. SEGINI MELVAL
  179. *
  180. DO 404 I=1,N1EL
  181. I1 = MIN(I,MELVA1.VELCHE(/2))
  182. I2 = MIN(I,MELVA2.VELCHE(/2))
  183. VELCHE(1,I)=MELVA2.VELCHE(1,I2)/MELVA1.VELCHE(1,I1)
  184. * write(6,*) 'Element', i , 'Dtcfl' , VELCHE(1,i)
  185. 404 CONTINUE
  186. MELV1 = MELVAL
  187. MELV2 = 0
  188. SEGDES MELVAL
  189. IF (ICAS.EQ.1) THEN
  190. SEGSUP MELVA1,MELVA2
  191. ELSE IF (ICAS.EQ.2) THEN
  192. SEGSUP MELVA2
  193. SEGDES MELVA1
  194. ELSE
  195. SEGSUP MELVA1
  196. SEGDES MELVA2
  197. ENDIF
  198. RETURN
  199. ENDIF
  200. *
  201.  
  202. 99 CONTINUE
  203. MOTERR(1:4)=NOMTP(MELE)
  204. MOTERR(9:12)='CFL5'
  205. CALL ERREUR(86)
  206. *
  207. RETURN
  208. END
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  

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