Télécharger joploc.eso

Retour à la liste

Numérotation des lignes :

  1. C JOPLOC SOURCE CHAT 05/01/13 00:50:04 5004
  2. SUBROUTINE JOPLOC(XE,SHPTOT,NBBB,NBNO,IFOU,XEL,BPSS)
  3. C
  4. C=======================================================================
  5. C
  6. C -CALCUL DE LA MATRICE DE PASSAGE BPSS
  7. C -CALCUL DES COORDONNEES LOCALES XEL
  8. C ROUTINE FORTRAN PUR POUR LES ELEMENTS JOINTS POREUX (BALD)
  9. C
  10. C=======================================================================
  11. C
  12. C INPUT
  13. C XE = COORDONNEES GLOBALES DE L ELEMENT
  14. C SHPTOT = FONCTIONS DE FORME
  15. C NBBB = NOMBRE DE NOEUDS DE L'ELEMENT
  16. C NBNO = NOMBRE DE FONCTIONS DE FORME
  17. C IFOU = IFOUR DE COPTIO
  18. C OUTPUT
  19. C XEL = COORDONNEES LOCALES DE L ELEMENT
  20. C BPSS = MATRICE DE PASAGE REPERE GLOBAL/REPERE LOCAL
  21. C
  22. C=======================================================================
  23. IMPLICIT INTEGER(I-N)
  24. IMPLICIT REAL*8(A-H,O-Z)
  25. DIMENSION XE(3,NBBB),XEL(3,NBBB),BPSS(3,3),SHPTOT(6,NBNO,*)
  26. DIMENSION V2(3),XD(3,20)
  27. DIMENSION S1(3),S2(3),SN(3)
  28. C
  29. NBNB=(3*NBBB-NBNO)/2
  30. NNNN=NBNB/2
  31. C
  32. DO 1 I=1,3
  33. S1(I)=0.0D0
  34. S2(I)=0.0D0
  35. SN(I)=0.0D0
  36. V2(I)=0.0D0
  37. 1 CONTINUE
  38. C
  39. CALL ZERO(BPSS,3,3)
  40. CALL ZERO(XD,3,20)
  41. CALL ZERO(XEL,3,NBBB)
  42. C
  43. IF (IFOU.EQ.2) THEN
  44. C
  45. C---------- CALCUL DE LA MATRICE DE PASSAGE
  46. C
  47. DO 2 I=1,NNNN
  48. C
  49. C-------------------TANGENTE AU POINT DE GAUSS 1 SELON QSI
  50. C
  51. S1(1) = S1(1) + ( SHPTOT(2,I,1)*XE(1,I) )
  52. S1(2) = S1(2) + ( SHPTOT(2,I,1)*XE(2,I) )
  53. S1(3) = S1(3) + ( SHPTOT(2,I,1)*XE(3,I) )
  54. C
  55. C-------------------TANGENTE AU POINT DE GAUSS 1 SELON ETA
  56. C
  57. V2(1) = V2(1) + ( SHPTOT(3,I,1)*XE(1,I) )
  58. V2(2) = V2(2) + ( SHPTOT(3,I,1)*XE(2,I) )
  59. V2(3) = V2(3) + ( SHPTOT(3,I,1)*XE(3,I) )
  60. 2 CONTINUE
  61. CALL NORMER(S1)
  62. CALL NORMER(V2)
  63. C
  64. C-------------------NORMALE AU PLAN DU JOINT
  65. C
  66. SN(1) = (S1(2)*V2(3)) - (S1(3)*V2(2))
  67. SN(2) = (S1(3)*V2(1)) - (S1(1)*V2(3))
  68. SN(3) = (S1(1)*V2(2)) - (S1(2)*V2(1))
  69. CALL NORMER(SN)
  70. C
  71. C-------------------ORTHOGONALISATION DE S2
  72. C
  73. S2(1) = (SN(2)*S1(3)) - (SN(3)*S1(2))
  74. S2(2) = (SN(3)*S1(1)) - (SN(1)*S1(3))
  75. S2(3) = (SN(1)*S1(2)) - (SN(2)*S1(1))
  76. CALL NORMER(S2)
  77. C
  78. C-------------------STOCKAGE DE LA MATRICE DE PASSAGE
  79. C
  80. DO 3 I=1,3
  81. BPSS(1,I) = S1(I)
  82. BPSS(2,I) = S2(I)
  83. BPSS(3,I) = SN(I)
  84. 3 CONTINUE
  85. C
  86. C---------- CALCUL DES COORDONNEES LOCALES DE L'ELEMENT
  87. C
  88. C-------------------CHANGEMENT D'ORIGINE ( ORIGINE AU NOEUD 1 )
  89. C
  90. DO 4 J=1,NBBB
  91. DO 5 I=1,3
  92. XD(I,J) = XE(I,J) - XE(I,1)
  93. 5 CONTINUE
  94. 4 CONTINUE
  95. C
  96. C-------------------PROJECTION SUR LE PLAN DU JOINT
  97. C
  98. DO 6 J=1,NBBB
  99. XEL(1,J)=XD(1,J)*S1(1)+XD(2,J)*S1(2)+XD(3,J)*S1(3)
  100. XEL(2,J)=XD(1,J)*S2(1)+XD(2,J)*S2(2)+XD(3,J)*S2(3)
  101. XEL(3,J)=0.0D0
  102. 6 CONTINUE
  103. C
  104. ELSE IF(IFOU.EQ.-2.OR.IFOU.EQ.-1.OR.IFOU.EQ.0)THEN
  105. C
  106. C---------- CALCUL DE LA MATRICE DE PASSAGE
  107. C
  108. DO 7 I=1,NNNN
  109. C
  110. C-------------------TANGENTE AU POINT DE GAUSS 1 SELON QSI
  111. C
  112. S1(1) = S1(1) + ( SHPTOT(2,I,1)*XE(1,I) )
  113. S1(2) = S1(2) + ( SHPTOT(2,I,1)*XE(2,I) )
  114. 7 CONTINUE
  115. C
  116. C-------------------NORMALISATION DE S1
  117. C
  118. XNORME = SQRT((S1(1)**2) + (S1(2)**2))
  119. S1(1) = S1(1) / XNORME
  120. S1(2) = S1(2) / XNORME
  121. C
  122. C-------------------NORMALE AU JOINT (PAR ROTATION DE 90 DEGRES)
  123. C
  124. SN(1) =-S1(2)
  125. SN(2) = S1(1)
  126. C
  127. C-------------------STOCKAGE DE LA MATRICE DE PASSAGE
  128. C
  129. DO 8 I=1,2
  130. BPSS(1,I) = S1(I)
  131. BPSS(2,I) = SN(I)
  132. 8 CONTINUE
  133. C
  134. C---------- CALCUL DES COORDONNEES LOCALES DE L'ELEMENT
  135. C
  136. C-------------------CHANGEMENT D'ORIGINE ( ORIGINE AU NOEUD 1)
  137. C
  138. DO 9 J=1,NBBB
  139. DO 10 I=1,2
  140. XD(I,J) = XE(I,J) - XE(I,1)
  141. 10 CONTINUE
  142. 9 CONTINUE
  143. C
  144. C-------------------PROJECTION SUR LE PLAN DU JOINT
  145. C
  146. DO 11 J=1,NBBB
  147. XEL(1,J)=XD(1,J)*S1(1)+XD(2,J)*S1(2)
  148. XEL(2,J)=0.0D0
  149. 11 CONTINUE
  150. C
  151. END IF
  152. C
  153. RETURN
  154. END
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  

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