Télécharger bsigdi.eso

Retour à la liste

Numérotation des lignes :

  1. C BSIGDI SOURCE FANDEUR 10/12/17 21:15:39 6427
  2.  
  3. SUBROUTINE BSIGDI (IPMAIL,IPMINT,NBPGAU,IVASTR,NSTRS,LRE,LDIFF,
  4. & IVAFOR,NFOR)
  5.  
  6. *----------------------------------------------------------------------*
  7. * CALCUL DES FLUX DE DIFFUSION NODAUX EQUIVALENTS *
  8. * Formulation 'DIFFUSION' (MFR=73) - Elements MASSIFs *
  9. *----------------------------------------------------------------------*
  10. * IPMAIL (E) Pointeur sur un segment MELEME *
  11. * IPMINT (E) Pointeur sur un segment MINTE (ACTIF) *
  12. * NBPGAU (E) Nombre de points d'integration pour les "contraintes" *
  13. * IVASTR (E) pointeur sur un segment MPTVAL contenant les *
  14. * les melvals de contraints *
  15. * NSTRS (E) Nombre de composantes de "contraintes/deformations" *
  16. * LRE (E) Nombre de DDL dans la matrice de "rigidite" *
  17. * LDIFF (E) Nombre de composantes de "deformations" = NSTRS *
  18. * IVAFOR (E) pointeur sur un segment MPTVAL contenant les *
  19. * les melvals de forces *
  20. * NFOR (E) Nombre de composantes de "flux" LRE = NBNN * NFOR *
  21. *----------------------------------------------------------------------*
  22. IMPLICIT INTEGER(I-N)
  23. IMPLICIT REAL*8(A-H,O-Z)
  24.  
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC CCREEL
  29.  
  30. -INC SMCHAML
  31. -INC SMELEME
  32. -INC SMCOORD
  33. -INC SMINTE
  34.  
  35. SEGMENT MWRK1
  36. REAL*8 XFORC(LRE), XFLUD(NSTRS), XEL(3,NBNN)
  37. REAL*8 SHP(6,NBNN), BGRDIF(LDIFF,LRE)
  38. ENDSEGMENT
  39.  
  40. SEGMENT MPTVAL
  41. INTEGER IPOS(NS) ,NSOF(NS)
  42. INTEGER IVAL(NCOSOU)
  43. CHARACTER*16 TYVAL(NCOSOU)
  44. ENDSEGMENT
  45.  
  46. MELEME = IPMAIL
  47. SEGACT,MELEME
  48. NBNN = NUM(/1)
  49. NBELEM = NUM(/2)
  50.  
  51. MINTE = IPMINT
  52. SEGACT,MINTE
  53.  
  54. SEGINI,MWRK1
  55.  
  56. C-------------------------
  57. C Boucle sur les elements
  58. C-------------------------
  59. DO IEL = 1, NBELEM
  60.  
  61. C - Recuperation des coordonnees des noeuds de l element IEL
  62. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XEL)
  63.  
  64. C - Initialisation des flux nodaux equivalents
  65. DO ICOMP = 1, LRE
  66. XFORC(ICOMP) = XZero
  67. ENDDO
  68. C
  69. MPTVAL = IVASTR
  70. C-- -- -- -- -- -- -- -- --
  71. C - Boucle sur les points de Gauss
  72. C-- -- -- -- -- -- -- -- --
  73. ISDJC = 0
  74. DO IGAU = 1, NBPGAU
  75. C -- Calcul de la matrice Bdif et du jacobien au point de Gauss IGAU
  76. CALL BDIFF(XEL,SHPTOT(1,1,IGAU),NBNN,LDIFF,1,
  77. & SHP,BGRDIF,DJAC)
  78. IF (DJAC.EQ.XZero) THEN
  79. INTERR(1) = IEL
  80. CALL ERREUR(259)
  81. GOTO 999
  82. ENDIF
  83. IF (DJAC.LT.XZero) ISDJC = ISDJC+1
  84. DJAC = ABS(DJAC)*POIGAU(IGAU)
  85. C -- Recuperation des flux au point d'integration (IGAU)
  86. DO ICOMP = 1, NSTRS
  87. MELVAL = IVAL(ICOMP)
  88. IGMN = MIN(IGAU,VELCHE(/1))
  89. IEMN = MIN(IEL ,VELCHE(/2))
  90. XFLUD(ICOMP) = VELCHE(IGMN,IEMN)
  91. ENDDO
  92. C -- Calcul du terme Bdif * Flux et de la contribution du point IGAU
  93. DO ICOMP = 1, LRE
  94. r_z = XZero
  95. DO JCOMP = 1, NSTRS
  96. r_z = r_z + BGRDIF(JCOMP,ICOMP) * XFLUD(JCOMP)
  97. ENDDO
  98. XFORC(ICOMP) = XFORC(ICOMP) + r_z*DJAC
  99. ENDDO
  100. C-- -- -- -- -- -- -- -- --
  101. ENDDO
  102. C-- -- -- -- -- -- -- -- --
  103. IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN
  104. INTERR(1) = IEL
  105. CALL ERREUR(195)
  106. GOTO 999
  107. ENDIF
  108. C - Stockage de XFORC dans le MELVAL IVAFOR
  109. MPTVAL = IVAFOR
  110. IE = 0
  111. DO IGAU = 1, NBNN
  112. DO ICOMP = 1, NFOR
  113. IE = IE + 1
  114. MELVAL = IVAL(ICOMP)
  115. IEMN = MIN(IEL,VELCHE(/2))
  116. VELCHE(IGAU,IEMN) = XFORC(IE)
  117. ENDDO
  118. ENDDO
  119. C-------------------------
  120. ENDDO
  121. C-------------------------
  122.  
  123. 999 CONTINUE
  124. SEGSUP,MWRK1
  125. SEGDES,MINTE,MELEME
  126.  
  127. RETURN
  128. END
  129.  
  130.  
  131.  

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