Télécharger defcar.eso

Retour à la liste

Numérotation des lignes :

  1. C DEFCAR SOURCE PV 09/03/12 21:19:07 6325
  2. SUBROUTINE DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  3. . WRK1)
  4. *
  5. ********************************************************
  6. * ENTREES
  7. ********************************************************
  8. *
  9. * NCARR : nombre de composantes des caractéristiques géométriques
  10. * ICARA : dimension de XCAR
  11. * IB : numéro de l'élément
  12. * IGAU : numéro du point de Gauss
  13. * MFR : formulation de l'élément
  14. * MELE : numéro de l'element fini
  15. * IVACAR : pointeur sur un segment mptval de caracteristiques geometrique
  16. *
  17. *******************************************************
  18. * SORTIES
  19. *******************************************************
  20. *
  21. * XCAR(ICARA) : caractéristiques géométriques (WRK1)
  22. *
  23. *******************************************************
  24. *
  25. IMPLICIT INTEGER(I-N)
  26. IMPLICIT REAL*8(A-H,O-Z)
  27. *
  28. -INC CCOPTIO
  29. -INC SMCHAML
  30. -INC SMCOORD
  31. *
  32. SEGMENT MPTVAL
  33. INTEGER IPOS(NS) ,NSOF(NS)
  34. INTEGER IVAL(NCOSOU)
  35. CHARACTER*16 TYVAL(NCOSOU)
  36. ENDSEGMENT
  37. *
  38. SEGMENT WRK1
  39. REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  40. REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  41. REAL*8 DEFP(NSTRS),XCAR(ICARA)
  42. ENDSEGMENT
  43. *
  44. SEGMENT WRKTRA
  45. REAL*8 TTRAV(NTTRAV)
  46. ENDSEGMENT
  47. *
  48. ICARA=XCAR(/1)
  49. IF(IVACAR.NE.0)THEN
  50. MPTVAL=IVACAR
  51. *
  52. * cas des tuyaux
  53. *
  54. IF(MFR.EQ.13)THEN
  55. DO 2106 IC=1,5
  56. MELVAL=IVAL(IC)
  57. IAUX=MELVAL
  58. IF(IAUX.NE.0)THEN
  59. IBMN=MIN(IB,VELCHE(/2))
  60. IGMN=MIN(IGAU,VELCHE(/1))
  61. XCAR(IC)=VELCHE(IGMN,IBMN)
  62. ELSE
  63. XCAR(IC)=0.D0
  64. ENDIF
  65. 2106 continue
  66. DO 2107 IC=6,NCARR-1
  67. MELVAL=IVAL(IC)
  68. IAUX=MELVAL
  69. IF(IAUX.NE.0)THEN
  70. IBMN=MIN(IB,VELCHE(/2))
  71. IGMN=MIN(IGAU,VELCHE(/1))
  72. XCAR(IC)=VELCHE(IGMN,IBMN)
  73. ELSE
  74. XCAR(IC)=-1.D0
  75. ENDIF
  76. 2107 continue
  77. IF(IVAL(NCARR).NE.0)THEN
  78. MELVAL=IVAL(NCARR)
  79. IBMN=MIN(IB,IELCHE(/2))
  80. IGMN=MIN(IGAU,IELCHE(/1))
  81. IP=IELCHE(IGMN,IBMN)
  82. IREF=(IP-1)*(IDIM+1)
  83. DO 2108 IC=1,IDIM
  84. XCAR(NCARR+IC-1)=XCOOR(IREF+IC)
  85. 2108 continue
  86. ELSE
  87. DO 2109 IC=1,IDIM
  88. XCAR(NCARR+IC-1)=0.D0
  89. 2109 continue
  90. ENDIF
  91. C
  92. C Poutre 3D
  93. C
  94. ELSE IF(MFR.EQ.7.AND.IDIM.EQ.3)THEN
  95. DO 1107 IC=1,NCARR-1
  96. MELVAL=IVAL(IC)
  97. IAUX=MELVAL
  98. IF(IAUX.NE.0)THEN
  99. IBMN=MIN(IB,VELCHE(/2))
  100. IGMN=MIN(IGAU,VELCHE(/1))
  101. XCAR(IC)=VELCHE(IGMN,IBMN)
  102. ELSE
  103. XCAR(IC)=0.D0
  104. ENDIF
  105. 1107 continue
  106. IF(IVAL(NCARR).NE.0)THEN
  107. MELVAL=IVAL(NCARR)
  108. IBMN=MIN(IB,IELCHE(/2))
  109. IGMN=MIN(IGAU,IELCHE(/1))
  110. IP=IELCHE(IGMN,IBMN)
  111. IREF=(IP-1)*(IDIM+1)
  112. DO 1108 IC=1,IDIM
  113. XCAR(NCARR+IC-1)=XCOOR(IREF+IC)
  114. 1108 continue
  115. ELSE
  116. DO 1109 IC=1,IDIM
  117. XCAR(NCARR+IC-1)=0.D0
  118. 1109 continue
  119. ENDIF
  120. C distinction entre poutre bernouilli et poutre timo en ce qui
  121. C concerne le defaut pour les sections reduites de l'effort tranchant
  122. IF(MFR.EQ.7.AND.MELE.EQ.84)THEN
  123. SD=XCAR(4)
  124. SREDY=XCAR(5)
  125. SREDZ=XCAR(6)
  126. IF(SREDY.EQ.0) XCAR(5)=SD
  127. IF(SREDZ.EQ.0) XCAR(6)=SD
  128. ENDIF
  129. C
  130. C Poutre 2D
  131. C
  132. ELSEIF(IDIM.EQ.2)THEN
  133. DO 1106 IC=1,NCARR
  134. MELVAL=IVAL(IC)
  135. IAUX=MELVAL
  136. IF(IAUX.NE.0)THEN
  137. IBMN=MIN(IB,VELCHE(/2))
  138. IGMN=MIN(IGAU,VELCHE(/1))
  139. XCAR(IC)=VELCHE(IGMN,IBMN)
  140. ELSE
  141. * cas des coques minces : défaut de alfah
  142. IF(IC.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN
  143. XCAR(IC)=0.66666666666666D0
  144. ELSE
  145. XCAR(IC)=0.D0
  146. ENDIF
  147. ENDIF
  148. 1106 continue
  149. C distinction entre poutre bernouilli et poutre timo en ce qui
  150. C concerne le defaut pour les sections reduites de l'effort tranchant
  151. SD=XCAR(1)
  152. if (ncarr.ge.3) then
  153. SREDY=XCAR(3)
  154. IF(SREDY.EQ.0) XCAR(3)=SD
  155. endif
  156. C
  157. ELSE
  158. DO 1110 IC=1,ICARA
  159. MELVAL=IVAL(IC)
  160. IAUX=MELVAL
  161. IF(IAUX.NE.0)THEN
  162. IBMN=MIN(IB,VELCHE(/2))
  163. IGMN=MIN(IGAU,VELCHE(/1))
  164. XCAR(IC)=VELCHE(IGMN,IBMN)
  165. ELSE
  166. * cas des coques minces : défaut de alfah
  167. IF (IC.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN
  168. XCAR(IC)=0.66666666666666D0
  169. ELSE
  170. XCAR(IC)=0.D0
  171. ENDIF
  172. ENDIF
  173. 1110 continue
  174. ENDIF
  175. *
  176. * rearrangement du tableau xcar pour qu'on ait le meme ordre
  177. * que l'ancien chamelem
  178. *
  179. IF(MFR.EQ.7.AND.IDIM.EQ.3)THEN
  180. VX=XCAR(ICARA-5)
  181. VY=XCAR(ICARA-4)
  182. VZ=XCAR(ICARA-3)
  183. XCAR(ICARA-5)=XCAR(ICARA-2)
  184. XCAR(ICARA-4)=XCAR(ICARA-1)
  185. XCAR(ICARA-3)=XCAR(ICARA)
  186. XCAR(ICARA-2)=VX
  187. XCAR(ICARA-1)=VY
  188. XCAR(ICARA)=VZ
  189. *
  190. ELSE IF(MFR.EQ.13)THEN
  191. NTTRAV = 7
  192. SEGINI WRKTRA
  193. DO 1111 IC=4,10
  194. TTRAV(IC-3)=XCAR(IC)
  195. 1111 continue
  196. IF(IDIM.EQ.2)THEN
  197. XCAR(4)=XCAR(ICARA-1)
  198. XCAR(5)=XCAR(ICARA)
  199. DO 1112 IC=1,NTTRAV
  200. XCAR(IC+5)=TTRAV(IC)
  201. 1112 continue
  202. ELSE IF(IDIM.EQ.3)THEN
  203. XCAR(4)=XCAR(ICARA-2)
  204. XCAR(5)=XCAR(ICARA-1)
  205. XCAR(6)=XCAR(ICARA)
  206. DO 1113 IC=1,NTTRAV
  207. XCAR(IC+6)=TTRAV(IC)
  208. 1113 continue
  209. ENDIF
  210. SEGSUP WRKTRA
  211. ENDIF
  212. ENDIF
  213. RETURN
  214. END
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  
  224.  

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