Télécharger calsig.eso

Retour à la liste

Numérotation des lignes :

  1. C CALSIG SOURCE BP208322 17/03/01 21:15:06 9325
  2. SUBROUTINE CALSIG(DEPST,DDAUX,NSTRS,CMATE,VALMAT,
  3. 1 VALCAR,N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST,
  4. 2 NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,
  5. 3 XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  6. *_______________________________________________________________________
  7. *
  8. *
  9. * ENTREES :
  10. * ---------
  11. *
  12. * DEPST = INCREMENT DE DEFORMATIONS TOTALES
  13. * DDAUX = MATRICE DE HOOKE ELASTIQUE
  14. * NSTRS = NBRE DE COMPOSANTES DES DEFORMATIONS
  15. * CMATE = NOM DU MATERIAU
  16. * VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU
  17. * VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES
  18. * N2EL = NBRE D ELEMENTS DANS SEGMENT DE HOOKE
  19. * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE
  20. * MFR = NUMERO DE LA FORMULATION
  21. * IFOU = OPTION DE CALCUL
  22. * IB = NUMERO DE L ELEMENT COURANT
  23. * IGAU = NUMERO DU POINT COURANT
  24. * EPAIST= EPAISSEUR
  25. * NBPGAU= NBRE DE POINTS DE GAUSS
  26. * MELE = NUMERO DE L ELEMENT FINI
  27. * NPINT = NBRE DE POINTS D INTEGRATION
  28. * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES
  29. * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES
  30. * SECT = SECTION
  31. * LHOOK = TAILLE DE LA MATRICE DE HOOKE
  32. * TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI = TABLEAUX UTILISES
  33. * POUR LE CALCUL DE LA MATRICE DE HOOKE
  34. *
  35. * SORTIE :
  36. * --------
  37. *
  38. * DSIGT = INCREMENT DE CONTRAINTES TOTALES
  39. *
  40. *_______________________________________________________________________
  41. *
  42. IMPLICIT INTEGER(I-N)
  43. IMPLICIT REAL*8(A-H,O-Z)
  44. *
  45. -INC CCREEL
  46. -INC CCOPTIO
  47. *
  48. *_______________________________________________________________________
  49. *
  50. DIMENSION VALMAT(*),VALCAR(*),VAR(1)
  51. DIMENSION TXR(IDIM,*),CRIGI(*),S(3)
  52. DIMENSION DEPST(*),DSIGT(*)
  53. DIMENSION COBMA(20),DDAUX(LHOOK,LHOOK)
  54. DIMENSION DDHOMU(LHOOK,LHOOK)
  55. DIMENSION XLOC(3,3),XGLOB(3,3)
  56. DIMENSION D1HOOK(LHOOK,*),ROTHOO(LHOOK,*)
  57. *
  58. PARAMETER(DEUX=2.D0,UNDEMI=.5D0)
  59. PARAMETER(X774=.774596669241483D0)
  60. PARAMETER(SIX=6.D0)
  61. *
  62. CHARACTER*8 CMATE
  63. C
  64. C
  65. IRTD=1
  66. CALL ZERO(COBMA,LHOOK,1)
  67. CALL ZERO(DSIGT,NSTRS,1)
  68. *
  69. IF(MFR.EQ.15.AND.NBPGAU.EQ.1) THEN
  70. S(1)= XZERO
  71. ELSE IF(MFR.EQ.15.AND.NBPGAU.EQ.3) THEN
  72. S(1)=-X774
  73. S(2)= XZERO
  74. S(3)= X774
  75. ENDIF
  76. *
  77. IF (IB.EQ.1.AND.IGAU.EQ.1) THEN
  78. GOTO 1000
  79. *
  80. ELSEIF (N2PTEL.EQ.1.AND.N2EL.EQ.1) THEN
  81. GOTO 2000
  82. *
  83. ELSEIF (N2PTEL.EQ.1.AND.N2EL.NE.1) THEN
  84. IF (IGAU.EQ.1) THEN
  85. GOTO 1000
  86. ELSE
  87. GOTO 2000
  88. ENDIF
  89. *
  90. ELSE
  91. GOTO 1000
  92. *
  93. ENDIF
  94. C
  95. 1000 CONTINUE
  96. *
  97. * write(6,*) 'calsi , nstrs mfr, nbgmat,nelmat mele , lhook,cmate'
  98. * write(6,*) 'calsig' ,nstrs,mfr, nbgmat,nelmat, mele ,lhook,cmate
  99. IRET=1
  100. CALL ZERO(DDAUX,LHOOK,LHOOK)
  101. *
  102. IF (CMATE.EQ.'ISOTROPE'.or.CMATE.EQ.'IMPELAST') THEN
  103. * Les modeles de comportement necessaitant l'appel a CALSIG ne
  104. * correspondent pas aux modeles de comportement dont la valeur
  105. * de INAT est referencee dans HOOKIS. Par consequent, nous
  106. * CHOISISSONS de fixer ARBITRAIREMENT INAT a 0 dans le present
  107. * sous-programme !
  108. INAT = 0
  109. CALL HOOKIS(VALMAT,VALCAR,VAR,MFR,IB,IGAU,0.D0,EPAIST,
  110. + INAT,MELE,NPINT,IFOU,1,NBGMAT,NELMAT,
  111. + S,SECT,LHOOK,DDHOMU,DDAUX,
  112. + COBMA,XMOB,IRET)
  113. C
  114. ELSE IF (CMATE.EQ.'ORTHOTRO') THEN
  115. CALL HOOKOR(VALMAT,IB,IGAU,MFR,0.D0,EPAIST,
  116. + MELE,NPINT,IFOU,1,NBGMAT,NELMAT,SECT,LHOOK,
  117. + TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDAUX,
  118. + COBMA,XMOB,IRET)
  119. C
  120. ELSE IF (CMATE.EQ.'ANISOTRO') THEN
  121. CALL HOOKAN(VALMAT,IB,IGAU,MFR,IFOU,1,NBGMAT,NELMAT,
  122. + SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDAUX,
  123. + MELE,COBMA,XMOB,IRET)
  124. C
  125. ELSE IF (CMATE.EQ.'UNIDIREC') THEN
  126. CALL HOOKUN(VALMAT,IB,IGAU,MFR,0.D0,EPAIST,
  127. + MELE,NPINT,IFOU,1,NBGMAT,NELMAT,SECT,LHOOK,
  128. + TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDAUX,
  129. + COBMA,XMOB,IRET)
  130. C
  131. ELSE IF (CMATE.EQ.'HOMOGENE') THEN
  132. CALL HOOKHO(VALMAT,IB,IGAU,MFR,NBGMAT,NELMAT,SECT,
  133. + LHOOK,DDAUX,IRET)
  134. C
  135. ELSE IF (CMATE.EQ.'SECTION') THEN
  136. CALL HOOKSE(VALMAT,IB,IGAU,MFR,CRIGI,IFOU,
  137. + NBGMAT,NELMAT,SECT,LHOOK,DDAUX,IRET)
  138. C
  139. ENDIF
  140. *
  141. IF (IRET.LE.0 ) GOTO 9990
  142. C
  143. *
  144. * cas des champs uniformes -> on ne recalcule pas DDAUX
  145. *
  146. 2000 CONTINUE
  147. *
  148. * cas des milieux poreux : 2 cas selon la valeur de NSTRS
  149. *
  150. IF(MFR.EQ.33.AND.LHOOK.LT.NSTRS) THEN
  151. *
  152. * cas sigeff
  153. *
  154. IF(XMOB.EQ.0.D0) THEN
  155. UNSURM=0.D0
  156. ELSE
  157. UNSURM=1.D0/XMOB
  158. ENDIF
  159. *
  160. DO 4500 I=1,LHOOK
  161. DSIGT(I)=-COBMA(I)*DEPST(NSTRS)
  162. DO 45001 J=1,LHOOK
  163. DSIGT(I)=DSIGT(I)+DDAUX(I,J)*DEPST(J)
  164. 45001 CONTINUE
  165. 4500 CONTINUE
  166. DSIGT(NSTRS)=DEPST(NSTRS)*UNSURM
  167. DO 4502 I=1,LHOOK
  168. DSIGT(NSTRS)=DSIGT(NSTRS)+COBMA(I)*DEPST(I)
  169. 4502 CONTINUE
  170. *
  171. * autres cas
  172. *
  173. ELSE
  174. DO 5500 I=1,min(LHOOK,NSTRS)
  175. DSIGT(I)=0.D0
  176. DO 55001 J=1,min(LHOOK,NSTRS)
  177. DSIGT(I)=DSIGT(I)+DDAUX(I,J)*DEPST(J)
  178. 55001 CONTINUE
  179. 5500 CONTINUE
  180. ENDIF
  181. *
  182. * CAS DES TUYAUX FISSURES
  183. *
  184. IF (MFR.EQ.17) THEN
  185. *
  186. YOU=VALMAT(1)
  187. RAYO=VALCAR(1)
  188. EPAI=VALCAR(2)
  189. TETA1=VALCAR(9)*UNDEMI
  190. C CONVERSION DE TETA1 EN RADIAN
  191. TETA = (TETA1 * XPI)/180.D0
  192. TESPI = TETA/XPI
  193. C ON MET DANS 'RAYMO' LE RAYON MOYEN DU TUYAU.
  194. RAYMO =RAYO - (EPAI/DEUX)
  195. C CALCUL DE A COEFIICIENT ZAHOR
  196. RSURT=RAYMO / EPAI
  197. IF(RSURT.LE.10.D0.AND.RSURT.GE.4.9D0) THEN
  198. AXX = ( .125D0*RSURT - .25D0 ) **.25D0
  199. ELSE IF(RSURT.GT.10.D0.AND.RSURT.LE.35.D0) THEN
  200. AXX = ( .4D0*RSURT - 3.D0 ) **.25D0
  201. ELSE
  202. KERRE=3
  203. ENDIF
  204. CALL TUFIFP(TESPI,AXX,FP,FM,FMP,FOP,FOM)
  205. C
  206. C
  207. C FACTEUR D INTENSITE DES CONTRAINTES
  208. C
  209. IF(TETA1.LE.(0.5D0))THEN
  210. DSIGT(7)=XZERO
  211. DSIGT(8)=XZERO
  212. GOTO 9992
  213. ENDIF
  214. SQQ= XPI * RAYMO * TETA
  215. SQQ= SQRT(SQQ)
  216. XEX= SQQ * FOP/(DEUX * XPI * RAYMO *EPAI)
  217. XFL= SQQ * FOM/(XPI * RAYMO * RAYMO *EPAI)
  218. DSIGT(7)=XEX * DSIGT(1) - XFL * DSIGT(6)
  219. C
  220. C CALCUL DES AIRES DE BRECHE NOTE TECHNIQUE DRE/STRE/LMA 85/695
  221. C
  222. SIGM=DSIGT(1)/( DEUX * XPI * RAYMO * EPAI )
  223. SIGF=DSIGT(6)/( XPI * RAYMO * RAYMO * EPAI )
  224. XIM= XPI * RAYMO * RAYMO * DEUX * TETA * TETA * FP /YOU
  225. XIF= XIM * ( .75D0 +(.25D0 * COS ( TETA )))
  226. DSIGT(8)=XIM * SIGM - XIF * SIGF
  227. ENDIF
  228. C
  229. *
  230. * CAS DES LISP ET LISM
  231. *
  232. IF (MFR.EQ.15) THEN
  233. EPA1=VALCAR(1)
  234. EPA2=VALCAR(6)
  235. FISS1=VALCAR(2)
  236. FISS2=VALCAR(7)
  237. FISS1 = (FISS1*(UNDEMI +UNDEMI/X774))+
  238. + (FISS2*(UNDEMI-UNDEMI/X774))
  239. FISS2 = (FISS1*(UNDEMI -UNDEMI/X774))+
  240. + (FISS2*(UNDEMI+UNDEMI/X774))
  241. W=(EPA1+EPA2)*UNDEMI
  242. H1=UNDEMI-UNDEMI*S(IGAU)
  243. H2=UNDEMI+UNDEMI*S(IGAU)
  244. A= H1*FISS1+H2*FISS2
  245. ASURW=(H1*FISS1+H2*FISS2)/W
  246. CALL LISPFI(ASURW,FM,FF)
  247. X1=DSIGT(1)/W
  248. X4=DSIGT(4)*SIX/(W*W)
  249. XXX=XPI*A
  250. XXX=SQRT(XXX)
  251. XKIE=(X1*FM+X4*FF)*XXX
  252. DSIGT(6)= XKIE
  253. *
  254. ENDIF
  255. *
  256. GOTO 9992
  257. *
  258. * ERREUR , RETOUR
  259. *
  260. 9990 CONTINUE
  261. IRTD=0
  262. *
  263. 9992 RETURN
  264. END
  265.  
  266.  
  267.  
  268.  
  269.  
  270.  
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  

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