Télécharger cubhr1.eso

Retour à la liste

Numérotation des lignes :

  1. C CUBHR1 SOURCE CHAT 05/01/12 22:32:36 5004
  2. C CUBHR1 SOURCE AM1 95/11/24 22:55:49 1918
  3. SUBROUTINE CUBHR1(IGAU,ITEL,MFR,NBNO,NIFOU,XEL,
  4. # SHPTOT,SHP,NST,ISDJC,XGENE,DJAC,IRET)
  5. C=======================================================================
  6. C
  7. C CALCULE LA MATRICE XGENE (NECESSAIRE POUR LE CALCUL DE LA MATRICE
  8. C DE RIGIDITE DANS LE CAS DE LA FORMULATION (37) HOMOGENE )
  9. C ROUTINE FORTRAN PUR
  10. C=======================================================================
  11. C INPUT
  12. C IGAU=NUMERO DU POINT DE GAUSS
  13. C ITEL=NUMERO DE L ELEMENT DANS NOMTP
  14. C MFR =NUMERO DE LA FORMULATION
  15. C NBNO=NOMBRE DE NOEUDS
  16. C LRE =NOMBRE DE COLONNES DE LA MATRICE B
  17. C IFOU=IFOUR DE CCOPTIO
  18. C NIFOU=NIFOUR DE CCOPTIO
  19. C XEL =COORDONNEES DE L ELEMENT
  20. C SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES
  21. C ISDJC = INDICATEUR SUR LE SIGNE DU JACOBIEN
  22. C ZONE DE TRAVAIL
  23. C SHP(6,NBNO)=TABLEAU DE TRAVAIL
  24. C OUTPUT
  25. C ISDJC = INDICATEUR SUR LE SIGNE DU JACOBIEN
  26. C NST =NBRE DE COLONNES DE LA MATRICE XGENE
  27. C DJAC=JACOBIEN
  28. C XGENE(NBNO,NST)=MATRICE (DE FONCTION DE FORME )
  29. C IRET= INDICATEUR = 1 : SUCCES
  30. C = 0 : ECHEC (ELEMENT INCOMPATIBLE )
  31. C = 2 : ECHEC (JACOBIEN NUL )
  32. C=======================================================================
  33. IMPLICIT INTEGER(I-N)
  34. IMPLICIT REAL*8(A-H,O-Z)
  35. DIMENSION XEL(3,*),XGENE((NBNO*2),2),SHP(6,*),SHPTOT(6,NBNO,*)
  36. IF (ITEL.EQ.127) GOTO 10
  37. C
  38. C ERREUR : TYPE D' ELEMENT INCOMPATIBLE AVEC LA FORMULATION
  39. C
  40. IRET = 0
  41. GOTO 666
  42. 10 CONTINUE
  43. DO 101 NP=1,NBNO
  44. SHP(1,NP)=SHPTOT(1,NP,IGAU)
  45. SHP(2,NP)=SHPTOT(2,NP,IGAU)
  46. SHP(3,NP)=SHPTOT(3,NP,IGAU)
  47. SHP(4,NP)=SHPTOT(4,NP,IGAU)
  48. 101 CONTINUE
  49. IDIM=3
  50. CALL JACOBI(XEL,SHP,IDIM,NBNO,DJAC)
  51. C WRITE(6,*)'DJAC1',DJAC
  52. IRET = 1
  53. IF (DJAC.LT.0.) ISDJC = ISDJC + 1
  54. DJAC = ABS(DJAC)
  55. C
  56. C CAS D'UN CALCUL TRIDIMENSIONNEL
  57. C
  58. NST = 2
  59. C
  60. CALL ZERO(XGENE,NBNO,NST)
  61. DO 103 NP=1,NBNO
  62. XGENE(NP,1)=SHP(1,NP)
  63. 103 CONTINUE
  64. C
  65. A1 = XEL(3,8) - XEL(3,1)
  66. A1 = ABS(A1)
  67. A2 = XEL(3,7) - XEL(3,1)
  68. A2 = ABS(A2)
  69. A3 = XEL(3,6) - XEL(3,1)
  70. A3 = ABS(A3)
  71. A4 = XEL(3,5) - XEL(3,1)
  72. A4 = ABS(A4)
  73. A5 = XEL(3,4) - XEL(3,1)
  74. A5 = ABS(A5)
  75. A6 = XEL(3,3) - XEL(3,1)
  76. A6 = ABS(A6)
  77. A7 = XEL(3,2) - XEL(3,1)
  78. A7 = ABS(A7)
  79. C
  80. A3 = (0.25D0)*(A1+A2+A3+A4+A5+A6+A7)
  81. C
  82. S1=SHP(1,1)+SHP(1,4)+SHP(1,5)+SHP(1,8)
  83. S2=SHP(1,2)+SHP(1,3)+SHP(1,6)+SHP(1,7)
  84. C
  85. T1=SHP(1,1)+SHP(1,2)+SHP(1,5)+SHP(1,6)
  86. T2=SHP(1,3)+SHP(1,4)+SHP(1,7)+SHP(1,8)
  87. C
  88. ZH=SHP(1,5)+SHP(1,6)+SHP(1,7)+SHP(1,8)
  89. C
  90. C DERIVEES SECONDES DES FONCTIONS Z
  91. C
  92. ZS1=(-6.D0/(A3**2))+((12.D0/(A3**2))*ZH)
  93. ZS2=-1.D0*ZS1
  94. ZS3=(-4.D0/A3)+((6.D0/A3)*ZH)
  95. ZS4=(-2.D0/A3)+((6.D0/A3)*ZH)
  96. C
  97. C FONCTIONS UTILISEES DANS TRIHR2.ESO
  98. C
  99. XGENE(1,2)=S1*T1*ZS1
  100. XGENE(2,2)=S2*T1*ZS1
  101. XGENE(3,2)=S2*T2*ZS1
  102. XGENE(4,2)=S1*T2*ZS1
  103. XGENE(5,2)=S1*T1*ZS2
  104. XGENE(6,2)=S2*T1*ZS2
  105. XGENE(7,2)=S2*T2*ZS2
  106. XGENE(8,2)=S1*T2*ZS2
  107.  
  108. XGENE(9,2)=S1*T1*ZS3
  109. XGENE(10,2)=S2*T1*ZS3
  110. XGENE(11,2)=S2*T2*ZS3
  111. XGENE(12,2)=S1*T2*ZS3
  112. XGENE(13,2)=S1*T1*ZS4
  113. XGENE(14,2)=S2*T1*ZS4
  114. XGENE(15,2)=S2*T2*ZS4
  115. XGENE(16,2)=S1*T2*ZS4
  116. C
  117. IRET=1
  118. C
  119. 666 CONTINUE
  120. RETURN
  121. END
  122.  
  123.  
  124.  
  125.  
  126.  

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