Télécharger quahr1.eso

Retour à la liste

Numérotation des lignes :

  1. C QUAHR1 SOURCE CHAT 05/01/13 02:41:02 5004
  2. C QUAHR1 SOURCE AM1 95/11/24 22:55:49 1918
  3. SUBROUTINE QUAHR1(IGAU,ITEL,MFR,NBNO,IFOU,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+NBNO),3),SHP(6,*),SHPTOT(6,NBNO,*)
  36. C PARAMETER(XZER=0.D0)
  37. IF (ITEL.EQ.126) GOTO 10
  38. C
  39. C ERREUR : TYPE D' ELEMENT INCOMPATIBLE AVEC LA FORMULATION
  40. C
  41. IRET = 0
  42. GOTO 666
  43. 10 CONTINUE
  44. DO 101 NP=1,NBNO
  45. SHP(1,NP)=SHPTOT(1,NP,IGAU)
  46. SHP(2,NP)=SHPTOT(2,NP,IGAU)
  47. SHP(3,NP)=SHPTOT(3,NP,IGAU)
  48. 101 CONTINUE
  49. CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NIFOU,2,1.D0,RR,DJAC)
  50. C WRITE(6,*)'RR=',RR
  51. C WRITE(6,*)'DJAC=',DJAC
  52. C WRITE(6,*)'SHP(1,1)=',SHP(1,1)
  53. IF (DJAC.LT.0.) ISDJC = ISDJC + 1
  54. IF ( DJAC.EQ.0.) GOTO 667
  55. DJAC = ABS(DJAC)
  56. C
  57. C CAS DE L'ELEMENT QUAH
  58. C
  59. C
  60. NST = 2
  61. CALL ZERO(XGENE,NBNO,NST)
  62. DO 113 NP=1,NBNO
  63. XGENE(NP,1)=SHP(1,NP)
  64. 113 CONTINUE
  65. C
  66. C FONCTIONS DE FORME
  67.  
  68. SHP(4,1)=SHP(1,1) + SHP(1,4)
  69. SHP(4,2)=SHP(1,2) + SHP(1,3)
  70. SHP(4,3)=0.D0
  71. SHP(4,4)=0.D0
  72. C
  73. A1=MIN(XEL(2,1),XEL(2,2))
  74. A2=MIN(XEL(2,1),XEL(2,3))
  75. A3=MIN(XEL(2,1),XEL(2,4))
  76. A4=MIN(A1,A2)
  77. A5=MIN(A1,A3)
  78. Z1=MIN(A4,A5)
  79. C WRITE(6,*)'Z1',Z1
  80. C
  81. B1=MAX(XEL(2,1),XEL(2,2))
  82. B2=MAX(XEL(2,1),XEL(2,3))
  83. B3=MAX(XEL(2,1),XEL(2,4))
  84. B4=MAX(B1,B2)
  85. B5=MAX(B1,B3)
  86. Z2=MAX(B4,B5)
  87. C WRITE(6,*)'Z2',Z2
  88. C
  89. RH=Z2-Z1
  90. XZH=SHP(1,3) + SHP(1,4)
  91. C
  92. S1=SHP(1,1) + SHP(1,4)
  93. S2=SHP(1,2) + SHP(1,3)
  94. C
  95. C FONCTIONS DE FORME EN Z
  96. C
  97. SHP(5,1)=1.D0-3.D0*XZH*XZH+2.D0*XZH*XZH*XZH
  98. SHP(5,2)=3.D0*XZH*XZH-2.D0*XZH*XZH*XZH
  99. C
  100. SHP(5,3)=(RH*XZH)*(1.D0-2.D0*XZH+XZH*XZH)
  101. SHP(5,4)=(RH*XZH)*(XZH*XZH-XZH)
  102. C
  103. C DERIVEES SECONDES / A Z DES FONCTIONS DE FORME EN Z
  104. C
  105. SHP(6,1)=(-6.D0/(RH**2))+((12.D0/(RH**2))*XZH)
  106. SHP(6,2)=-1.D0*SHP(6,1)
  107. SHP(6,3)=(-4.D0/RH)+((6.D0/RH)*XZH)
  108. SHP(6,4)=(-2.D0/RH)+((6.D0/RH)*XZH)
  109. C
  110. C DERIVEES SECONDES DES FONCTIONS DE FORME POUR LA FLEXION
  111. C
  112. C POUR LES DEPLACEMENTS
  113. C
  114. XGENE(1,2)=S1*SHP(6,1)
  115. XGENE(2,2)=S2*SHP(6,1)
  116. XGENE(3,2)=S2*SHP(6,2)
  117. XGENE(4,2)=S1*SHP(6,2)
  118. C
  119. C POUR LES ROTATIONS
  120. C
  121. XGENE(5,2)=S1*SHP(6,3)
  122. XGENE(6,2)=S2*SHP(6,3)
  123. XGENE(7,2)=S2*SHP(6,4)
  124. XGENE(8,2)=S1*SHP(6,4)
  125. C
  126. IRET=1
  127. C
  128. GOTO 666
  129. 667 CONTINUE
  130. C
  131. C JACOBIEN NUL
  132. C
  133. IRET = 2
  134. C
  135. 666 CONTINUE
  136. RETURN
  137. END
  138.  
  139.  
  140.  
  141.  
  142.  

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