Télécharger coq8gy.eso

Retour à la liste

Numérotation des lignes :

  1. C COQ8GY SOURCE BP208322 11/09/14 21:15:01 7130
  2. SUBROUTINE COQ8GY(NBNO,RHOK,NBPGAU,WRK1,MINTE,MINTE2,WRK7)
  3. C
  4. C |--------------------------------------------------------------|
  5. C | NOUVELLE PROCEDURE DE CALCUL DE LA MATRICE DE COUPLAGE |
  6. C | COUPLAGE GYROSCOPIQUE AVEC UN ELEMENT DE COQUE A 6/8 NOEUDS |
  7. C | |
  8. C | INSPIRE DU CALCUL DE LA MATRICE DE MASSE |
  9. C |--------------------------------------------------------------|
  10. C | ENTREES |
  11. C | NBPGAU : NOMBRE DE POINTS DE GAUSS. |
  12. C | MINTE : FONCTIONS DE FORME AUX POINTS DE GAUSS |
  13. C | MINTE2 : FONCTIONS DE FORME AUX NOEUDS |
  14. C | RHOK : MASSE VOLUMIQUE. |
  15. C | NBNO : NOMBRE DE NOEUDS |
  16. C | WRK7 : SEGMENT DE TRAVAIL (ACTIF) |
  17. C | Didier COMBESCURE mars 2003 |
  18. C |--------------------------------------------------------------|
  19. C
  20. IMPLICIT INTEGER(I-N)
  21. IMPLICIT REAL*8 (A-H,O-Z)
  22.  
  23. -INC SMINTE
  24.  
  25. SEGMENT WRK7
  26. REAL*8 XJI(3,3),TXR(3,3,NBNO),FINT(3,LRE),XJ(3,3),B(3,3)
  27. REAL*8 TH(NBNO),EXC(NBNO),H(NBNO)
  28. REAL*8 ROME(3,3),REWO(LRE,LRE)
  29. ENDSEGMENT
  30. SEGMENT WRK1
  31. REAL*8 REL(LRE,LRE),XE(3,NBNO)
  32. ENDSEGMENT
  33. C
  34. C INITIALISATION DE LA MATRICE DE COUPLAGE
  35. C
  36. LRE=6*NBNO
  37. DO 10 J = 1,LRE
  38. DO 10 I = 1,LRE
  39. REL(I,J) = 0.D0
  40. REWO(I,J) = 0.D0
  41. 10 CONTINUE
  42. *
  43. ESP = TH(1)
  44. EXCEN = EXC(1)
  45. *
  46. * CORRECTION RNUR LE 12 / 9 / 90
  47. *
  48. CALL CQ8LOC(XE,NBNO,MINTE2.SHPTOT,TXR,IRR)
  49. *
  50. DO 80 LX = 1,NBPGAU
  51. E3 = DZEGAU(LX)
  52. WT = POIGAU (LX)
  53. DO 20 I=1,NBNO
  54. 20 H(I)=SHPTOT(1,I,LX)
  55. CALL CQ8JCE(LX,NBNO,E3,XE,TH,EXC,TXR,SHPTOT,B,DET,IRR)
  56. FACT = WT*DET*RHOK
  57. DO 30 J = 1, LRE
  58. FINT(1,J) = 0.D0
  59. FINT(2,J) = 0.D0
  60. FINT(3,J) = 0.D0
  61. 30 CONTINUE
  62. XJI(1,1) = 0.D0
  63. XJI(2,2) = 0.D0
  64. XJI(3,3) = 0.D0
  65. DO 60 J = 1,NBNO
  66. XJI(1,2) = TXR(1,1,J)*TXR(2,2,J) - TXR(2,1,J)*TXR(1,2,J)
  67. XJI(1,3) = TXR(1,1,J)*TXR(3,2,J) - TXR(1,2,J)*TXR(3,1,J)
  68. XJI(2,1) = -XJI(1,2)
  69. XJI(2,3) = TXR(2,1,J)*TXR(3,2,J) - TXR(2,2,J)*TXR(3,1,J)
  70. XJI(3,1) = -XJI(1,3)
  71. XJI(3,2) = -XJI(2,3)
  72. J1 = (J-1)*6 + 1
  73. J2 = J1 + 1
  74. J3 = J2 + 1
  75. J4 = J3 + 1
  76. J5 = J4 + 1
  77. J6 = J5 + 1
  78. A1 = H(J)*(0.5*E3*ESP+EXCEN)
  79. FINT(1,J1) = H(J)
  80. FINT(1,J5) = A1*XJI(1,2)
  81. FINT(1,J6) = A1*XJI(1,3)
  82. FINT(2,J2) = FINT(1,J1)
  83. FINT(2,J4) = -FINT(1,J5)
  84. FINT(2,J6) = A1*XJI(2,3)
  85. FINT(3,J3) = FINT(1,J1)
  86. FINT(3,J4) = -FINT(1,J6)
  87. 60 FINT(3,J5) = -FINT(2,J6)
  88. DO 70 I = 1, LRE
  89. DO 70 J = I, LRE
  90. r_z = 0.D0
  91. DO 71 K = 1,3
  92. r_z = r_z + FINT(K,I)*FINT(K,J)
  93. 71 CONTINUE
  94. REWO(I,J) = REWO(I,J) + (FACT * r_z)
  95. c REWO(J,I) = REWO(I,J)
  96. c bp : on peut faire encore + efficace en executant cette ligne
  97. c apres la boucle 80 (cf boucle 77)
  98. 70 CONTINUE
  99. 80 CONTINUE
  100. DO 77 I = 1, LRE
  101. DO 77 J = I, LRE
  102. REWO(J,I) = REWO(I,J)
  103. 77 CONTINUE
  104. C
  105. DO 90 I = 1,NBNO
  106. DO 90 J = 1,NBNO
  107. DO 90 IN = 1,3
  108. DO 90 IM = 1,3
  109. REL((6*I)-6+IN,(6*J)-6+IM)=REWO((6*I)-6+IM,(6*J)-6+IM)
  110. . *ROME(IN,IM)
  111. REL((6*I)-3+IN,(6*J)-6+IM)=REWO((6*I)-3+IM,(6*J)-6+IM)
  112. . *ROME(IN,IM)
  113. REL((6*I)-6+IN,(6*J)-3+IM)=REWO((6*I)-6+IM,(6*J)-3+IM)
  114. . *ROME(IN,IM)
  115. REL((6*I)-3+IN,(6*J)-3+IM)=REWO((6*I)-3+IM,(6*J)-3+IM)
  116. . *ROME(IN,IM)
  117. C
  118. 90 CONTINUE
  119. C
  120. RETURN
  121. END
  122.  
  123.  
  124.  
  125.  

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