Télécharger devpr2.eso

Retour à la liste

Numérotation des lignes :

  1. C DEVPR2 SOURCE BP208322 20/09/18 21:15:41 10718
  2.  
  3. c SUBROUTINE DEVPR2(XPHILB,FTOTB,FTOTBA,KTOTXB,KTOTVB,KTOTXBA,
  4. c & KTOTVBA,IBASB,INMSB,IPLSB,IORSB,NSB,NPLSB,NA2,IDIMB,NPLB,NA1)
  5. SUBROUTINE DEVPR2(XPHILB,FTOTB,FTOTBA,KTOTXB,KTOTVB,KTOTXA,
  6. & KTOTVA,IBASB,INMSB,IPLSB,IORSB,NSB,NPLSB,NA2,IDIMB,NPLB,NA1)
  7.  
  8. *--------------------------------------------------------------------*
  9. * *
  10. * Operateurs DYNE/DYNC *
  11. * ________________________________________________ *
  12. * *
  13. * Projection des forces base r{elle sur base A. *
  14. * *
  15. * Param}tres: *
  16. * *
  17. * e XPHILB Tableau des vecteurs propres aux points de liaisons. *
  18. * XPHILB(iBase,jptB,i,idim) *
  19. * e FTOTB Tableau des forces sur base B. *
  20. * s FTOTBA Tableau des forces base B projet{es sur base A. *
  21. * F_i = \phi_i(x_{jptB},id)^T * F(x_{jptB},id)
  22. * = projection sur le mode i de la force de liaison IP
  23. * au point jptB (IPLB) selon la direction id
  24. * e KTOTB Tableau des raideurs tangentes sur base B *
  25. * s KTOTBA Tableau des raiduers tangentes base B projetees sur *
  26. * base A.
  27. * e IBASB Indique dans quelle sous base appartient le point de *
  28. * liaison. *
  29. * e INMSB Nombre de modes par sous base. *
  30. * e IORSB Donne l'indice du premier mode de la sous base dans *
  31. * l'ensemble des modes. *
  32. * e NSB Nombre total de sous base. *
  33. * e NPLSB Nombre total de points intervenant dans les liaisons *
  34. * d'une sous base. *
  35. * e NPLB Nombre total de points intervenant dans les liaisons. *
  36. * e IDIMB Nombre de ddl retenus. *
  37. * e NA1 Nombre total d'inconnues en base A. *
  38. * *
  39. * *
  40. *--------------------------------------------------------------------*
  41. IMPLICIT INTEGER(I-N)
  42. IMPLICIT REAL*8(A-H,O-Z)
  43. INTEGER IBASB(*),INMSB(*),IPLSB(*),IORSB(*)
  44. REAL*8 XPHILB(NSB,NPLSB,NA2,*),FTOTB(NPLB,*),FTOTBA(*)
  45. REAL*8 KTOTXB(NPLB,IDIMB,IDIMB),KTOTVB(NPLB,IDIMB,IDIMB)
  46. c REAL*8 KTOTXBA(NA1,NA1), KTOTVBA(NA1,NA1)
  47. REAL*8 KTOTXA(NA1,NA1), KTOTVA(NA1,NA1)
  48. c REAL*8 KTOTXBA0(NA1,NA1), KTOTVBA0(NA1,NA1)
  49. c REAL*8 KTEMPX(NA1,IDIMB), KTEMPV(NA1,IDIMB)
  50. c REAL*8 MPAS(IDIMB,NA1), MPAST(NA1,IDIMB)
  51.  
  52. *----------------------------------------------------------------------*
  53. * Initialisation a 0
  54. DO IN = 1,NA1
  55. FTOTBA(IN) = 0.D0
  56. ENDDO
  57. c c prevoir if (janalytic) then
  58. c DO IM = 1,NA1
  59. c DO IN = 1,NA1
  60. c KTOTXBA(IN,IM) = 0.
  61. c KTOTVBA(IN,IM) = 0.
  62. c ENDDO
  63. c ENDDO
  64. c c prevoir endif
  65.  
  66. *----------------------------------------------------------------------*
  67. * Boucle sur les points des liaisons base B : l=1..
  68. DO IP = 1,NPLB
  69.  
  70. ISB = IBASB(IP)
  71. IPLB = IPLSB(IP)
  72. NA3 = INMSB(ISB)
  73. INA2 = IORSB(ISB) - 1
  74.  
  75. * Boucle sur les modes : i=1.. (IN = i de la sous base, IN2 = i global)
  76. DO IN = 1,NA3
  77. XRET = 0.D0
  78. * Boucle sur les directions : k=1..3
  79. DO ID = 1,IDIMB
  80. XRET = XRET + XPHILB(ISB,IPLB,IN,ID) * FTOTB(IP,ID)
  81. ENDDO
  82. IN2 = INA2 + IN
  83. * Cumul des forces projetees :
  84. * F_i = \sum_l (\sum_k (\Phi_i(x_l)*e_k) * F_lk)
  85. FTOTBA(IN2) = FTOTBA(IN2) + XRET
  86. ENDDO
  87.  
  88. * Projection des matrices tangentes
  89. c * (pour l'instant le cas avec plusieurs bases n'est pas prevu)
  90. c IF (INA2.NE.0) THEN
  91. c * Si une unique base, NA3 = NA1 et INA2 = 0
  92. c WRITE(*,*) 'Oh, no. INA2 = ', INA2
  93. c CALL ERREUR(491)
  94. c CALL ERREUR(5)
  95. c STOP
  96. c ENDIF
  97. c * Projection des matrices tangentes
  98. c * Matrice de passage (def. modale) et sa transposee
  99. c DO JJ = 1,IDIMB
  100. c DO II = 1,NA1
  101. c MPAST(II,JJ) = XPHILB(ISB,IPLB,II,JJ)
  102. c MPAS(JJ,II) = MPAST(II,JJ)
  103. c ENDDO
  104. c ENDDO
  105. c * KTOTX
  106. c CALL PRMATNC(NA1,IDIMB,IDIMB,MPAST,KTOTXB,KTEMPX)
  107. c CALL PRMATNC(NA1,IDIMB,NA1,KTEMPX,MPAS,KTOTXBA0)
  108. c * KTOTV
  109. c CALL PRMATNC(NA1,IDIMB,IDIMB,MPAST,KTOTVB,KTEMPV)
  110. c CALL PRMATNC(NA1,IDIMB,NA1,KTEMPV,MPAS,KTOTVBA0)
  111. c DO J = 1,NA1
  112. c DO I = 1,NA1
  113. c KTOTXBA(I,J) = KTOTXBA(I,J) + KTOTXBA0(I,J)
  114. c KTOTVBA(I,J) = KTOTVBA(I,J) + KTOTVBA0(I,J)
  115. c ENDDO
  116. c ENDDO
  117.  
  118. cbp : ci-dessus me semble faux... --> on reecrit
  119.  
  120. * Projection des matrices tangentes calculees analytiquement
  121. c prevoir if (janalytic) then
  122. * Boucle 1 sur les modes : i=1.. (IN = i de la sous base, IN2 = i global)
  123. DO IN = 1,NA3
  124. IN2 = INA2 + IN
  125. * Boucle 2 sur les modes : j=1..
  126. DO JN = 1,NA3
  127. JN2 = INA2 + JN
  128. XRET = 0.D0
  129. VRET = 0.D0
  130. * Boucle 1 sur les directions : k=1..3
  131. DO ID = 1,IDIMB
  132. * Boucle 2 sur les directions : k'=1..3
  133. DO JD = 1,IDIMB
  134. XRET = XRET + ( XPHILB(ISB,IPLB,IN,ID) * KTOTXB(IP,ID,JD)
  135. & * XPHILB(ISB,IPLB,JN,JD) )
  136. VRET = VRET + ( XPHILB(ISB,IPLB,IN,ID) * KTOTVB(IP,ID,JD)
  137. & * XPHILB(ISB,IPLB,JN,JD) )
  138. ENDDO
  139. ENDDO
  140. * Cumul des raideurs projetees :
  141. * K_ij = \sum_l \sum_k \sum_k' (\Phi_i(x_l)*e_k) * K_lkk' * (\Phi_j(x_l)*e_k')
  142. c KTOTXBA(IN2,JN2) = KTOTXBA(IN2,JN2) + XRET
  143. c KTOTVBA(IN2,JN2) = KTOTVBA(IN2,JN2) + VRET
  144. KTOTXA(IN2,JN2) = KTOTXA(IN2,JN2) + XRET
  145. KTOTVA(IN2,JN2) = KTOTVA(IN2,JN2) + VRET
  146. ENDDO
  147. ENDDO
  148. c prevoir endif
  149.  
  150.  
  151. ENDDO
  152.  
  153. END
  154.  
  155.  
  156.  
  157.  

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