Télécharger fpcoq8.eso

Retour à la liste

Numérotation des lignes :

  1. C FPCOQ8 SOURCE MB234859 16/10/07 21:15:07 9121
  2. SUBROUTINE FPCOQ8(IPTVPR,IPMAIL,IPTINT,IVACAR,IPTNOE,IVAFOR)
  3. *______________________________________________________________________
  4. *
  5. * CALCULE LES FORCES DE PRESSION AUX NOEUDS DES COQUES COQ8 ,COQ6
  6. *
  7. *
  8. * ENTREES :
  9. * ---------
  10. *
  11. * IPTVPR POINTEUR SUR LE CHAMELEM DES PRESSIONS (actif)
  12. * IPMAIL POINTEUR LE MAILLAGE (actif)
  13. * IPTINT POINTEUR SUR LE CHAMELEM DE L'INTEGRATION
  14. * (SEGMENT ACTIF EN ENTREE, NON MODIFIE EN SORTIE)
  15. * IVACAR POINTEUR SUR UN SEGMENT MPTVAL CONCERNANT LES CARA-
  16. * CTERISTIQUES (EPAISSEUR AUX NOEUDS)
  17. * IPTNOE POINTEUR SUR L'ALIAS DU CHAMELEM D'INTEGRATION CONTENANT
  18. * LES FONCTIONS DE FORME AUX NOEUDS
  19. * IVAFOR POINTEUR SUR UN MPTVAL ET MELVALS ASSOCIEES AUX FORCES
  20. * ET MOMENTS AUX NOEUDS
  21. *
  22. * PASSAGE AUX NOUVEAU CHAMELEM PAR JM CAMPENON LE 13 09 90
  23. *
  24. *_______________________________________________________________________
  25. *
  26. IMPLICIT INTEGER(I-N)
  27. IMPLICIT REAL*8(A-H,O-Z)
  28. *
  29. -INC SMCHAML
  30. -INC SMELEME
  31. -INC SMINTE
  32. -INC SMCOORD
  33. -INC CCOPTIO
  34. *
  35. SEGMENT MPTVAL
  36. INTEGER IPOS(NS) ,NSOF(NS)
  37. INTEGER IVAL(NCOSOU)
  38. CHARACTER*16 TYVAL(NCOSOU)
  39. ENDSEGMENT
  40. *
  41. DIMENSION TH(8),VNGAU(3),XJ(3,3),TXR(3,3,8),XE(3,8)
  42. *
  43. MELVA1=IPTVPR
  44. *
  45. MINTE=IPTINT
  46. c* SEGACT MINTE <- Actif en E/S
  47. NBPGAU=POIGAU(/1)
  48. NBGAU2=NBPGAU/2
  49. *
  50. MINTE1=IPTNOE
  51. SEGACT MINTE1
  52. *
  53. MELEME=IPMAIL
  54. NBELEM=NUM(/2)
  55. NBNN=NUM(/1)
  56. *
  57. * BOUCLE SUR LES ELEMENTS
  58. *
  59. DO 1 IB=1,NBELEM
  60. *
  61. * CALCUL DE L'INDICE D'ORIENTATION DE LA COQUE % PRESSION
  62. * DANS FPCOQU LES ELEMENTS SONT REORIENTES EN FONCTION DU VECTEUR
  63. * DIRECTIONNEL DE LA PRESSION DONC LA PRESSION EST APPLIQUEE
  64. * SUR LA FACE -1
  65. *
  66. ZETA=-1.D0
  67. *
  68. * CALCUL DE L EPAISSEUR MOYENNE
  69. * CALCUL DE TH(IPTELE)
  70. *
  71. EPAI=0.D0
  72. MPTVAL=IVACAR
  73. MELVAL=IVAL(1)
  74. IBMN=MIN(IB,VELCHE(/2))
  75. IF(VELCHE(/1).EQ.1) EPAI=VELCHE(1,IBMN)
  76. IF(VELCHE(/1).GT.1) THEN
  77. DO 2 I=1,VELCHE(/1)
  78. EPAI=EPAI+VELCHE(I,IBMN)
  79. 2 CONTINUE
  80. EPAI=EPAI/VELCHE(/1)
  81. ENDIF
  82. DO 3 J=1,NBNN
  83. TH(J)=EPAI
  84. 3 CONTINUE
  85. *
  86. * DETERMINATION DES REPERES LOCAUX AUX NOEUDS
  87. *
  88. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  89. CALL CQ8LOC(XE,NBNN,MINTE1.SHPTOT,TXR,IRR)
  90. *
  91. * BOUCLE SUR LES POINTS DE GAUSS
  92. *
  93. IBMN=MIN(IB,MELVA1.VELCHE(/2))
  94. DO 10 IGAU=1,NBGAU2
  95. IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
  96. PRE=MELVA1.VELCHE(IGMN,IBMN)
  97. *
  98. * VECTEUR NORMAL A LA SURFACE DE L ELEMENT AU PT DE GAUSS IGAU
  99. * NE PAS NORMALISER LE VECTEUR CAR IL INTEGRE L'ELEMENT
  100. * DE SURFACE POUR L'INTEGRATION
  101. *
  102. CALL COQ8JC(IGAU,NBNN,ZETA,XE,TH,TXR,SHPTOT,XJ,DET,IRR)
  103. VNGAU(1)=XJ(1,2)*XJ(2,3)-XJ(2,2)*XJ(1,3)
  104. VNGAU(2)=XJ(1,3)*XJ(2,1)-XJ(2,3)*XJ(1,1)
  105. VNGAU(3)=XJ(1,1)*XJ(2,2)-XJ(2,1)*XJ(1,2)
  106. *
  107. * BOUCLE SUR NOEUDS DE L'ELEMENT
  108. *
  109. MPTVAL=IVAFOR
  110. DO 20 J=1,NBNN
  111. *
  112. * FORCES AUX NOEUDS
  113. *
  114. WGTF=POIGAU(IGAU)*PRE
  115. MELVAL=IVAL(1)
  116. VELCHE(J,IB)=VELCHE(J,IB)+WGTF*SHPTOT(1,J,IGAU)*VNGAU(1)
  117. MELVAL=IVAL(2)
  118. VELCHE(J,IB)=VELCHE(J,IB)+WGTF*SHPTOT(1,J,IGAU)*VNGAU(2)
  119. MELVAL=IVAL(3)
  120. VELCHE(J,IB)=VELCHE(J,IB)+WGTF*SHPTOT(1,J,IGAU)*VNGAU(3)
  121. *
  122. * (V2JT)
  123. * MOMENTS AUX NDS = 0.5*ZETA*WT*P*TH(J)* (V1J,-V2J)(V1JT) *(VNGAU)
  124. *
  125. * CALCUL DE LA MATRICE DE PASSAGE NOTEE XJ(3,3)
  126. *
  127. DO 50 I=1,3
  128. XJ(I,I)=0.
  129. 50 CONTINUE
  130. XJ(1,2) = TXR(1,1,J)*TXR(2,2,J)-TXR(2,1,J)*TXR(1,2,J)
  131. XJ(1,3) = TXR(1,1,J)*TXR(3,2,J)-TXR(1,2,J)*TXR(3,1,J)
  132. XJ(2,3) = TXR(2,1,J)*TXR(3,2,J)-TXR(2,2,J)*TXR(3,1,J)
  133. DO 51 I=1,3
  134. DO 51 L=I,3
  135. XJ(L,I) = -XJ(I,L)
  136. 51 CONTINUE
  137. *
  138. * VALEURS DES MOMENTS AUX NOEUDS
  139. *
  140. WGTM=0.5D0*ZETA*TH(J)*POIGAU(IGAU)*PRE
  141. *
  142. DO 60 I=1,3
  143. MELVAL=IVAL(4)
  144. VELCHE(J,IB)=VELCHE(J,IB)+WGTM*SHPTOT(1,J,IGAU)*XJ(I,1)*VNGAU(I)
  145. MELVAL=IVAL(5)
  146. VELCHE(J,IB)=VELCHE(J,IB)+WGTM*SHPTOT(1,J,IGAU)*XJ(I,2)*VNGAU(I)
  147. MELVAL=IVAL(6)
  148. VELCHE(J,IB)=VELCHE(J,IB)+WGTM*SHPTOT(1,J,IGAU)*XJ(I,3)*VNGAU(I)
  149. 60 CONTINUE
  150. 20 CONTINUE
  151. 10 CONTINUE
  152. 1 CONTINUE
  153.  
  154. c* SEGDES MINTE <- Actif en E/S
  155. SEGDES MINTE1
  156. * Segment supprime dans fpcoqu.eso
  157. c* SEGSUP MELVA1
  158.  
  159. RETURN
  160. END
  161.  
  162.  
  163.  
  164.  

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