Télécharger fscoq4.eso

Retour à la liste

Numérotation des lignes :

  1. C FSCOQ4 SOURCE FANDEUR 12/07/18 21:15:38 7434
  2.  
  3. SUBROUTINE FSCOQ4(IPT,IPMAIL,IPTINT,IPVECT,V,IVAFOR)
  4. *____________________________________________________________________
  5. *
  6. * CALCULE LES FORCES SURFACIQUES SUR LES COQUES COQ4 3D
  7. *
  8. * ENTREES :
  9. * ---------
  10. *
  11. * IPT TABLEAU DE POINTEURS SUR MPTVAL CONTENANT LES FORCES
  12. * APPLIQUEES
  13. * IPMAIL OBJET GEOMETRIQUE
  14. * IPTINT POINTEUR SUR UN MINTE CONTENANT LES POINTS D INTEGRATION
  15. * IPVECT POINTEUR SUR LE VECTEUR REPRESENTANT LA FORCE
  16. * V VECTEUR REPRESENTANT LA FORCE
  17. * IVAFOR POINTEUR SUR UN MPTVAL ET DES MELVALS DEVANT CONTENIR
  18. * LES FORCES NODALES RESULTANTES
  19. *
  20. * G. M. GIANNUZZI SETT 86
  21. * PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 12 09 90
  22. *
  23. *____________________________________________________________________
  24. *
  25. IMPLICIT INTEGER(I-N)
  26. IMPLICIT REAL*8(A-H,O-Z)
  27. *
  28. -INC CCOPTIO
  29. *
  30. -INC SMCHAML
  31. -INC SMELEME
  32. -INC SMINTE
  33. -INC SMCOORD
  34. *
  35. SEGMENT MPTVAL
  36. INTEGER IPOS(NS) ,NSOF(NS)
  37. INTEGER IVAL(NCOSOU)
  38. CHARACTER*16 TYVAL(NCOSOU)
  39. ENDSEGMENT
  40. *
  41. DIMENSION IPT(*), V(*)
  42.  
  43. DIMENSION XE(3,4),XEL(3,4),BPSS(3,3),SHP(6,4),FTLOC(24),FTGLO(24)
  44.  
  45. MELVA1 = IPT(1)
  46. MELVA2 = IPT(2)
  47. MELVA3 = IPT(3)
  48. IF (IPVECT.EQ.0) THEN
  49. IF (MELVA1.NE.0) THEN
  50. SEGACT,MELVA1
  51. IGM1 = MELVA1.VELCHE(/1)
  52. IBM1 = MELVA1.VELCHE(/2)
  53. ENDIF
  54. IF (MELVA2.NE.0) THEN
  55. SEGACT,MELVA2
  56. IGM2 = MELVA2.VELCHE(/1)
  57. IBM2 = MELVA2.VELCHE(/2)
  58. ENDIF
  59. IF (MELVA3.NE.0) THEN
  60. SEGACT,MELVA3
  61. IGM3 = MELVA3.VELCHE(/1)
  62. IBM3 = MELVA3.VELCHE(/2)
  63. ENDIF
  64. F1 = 0.D0
  65. F2 = 0.D0
  66. F3 = 0.D0
  67. ELSE
  68. F1 = V(1)
  69. F2 = V(2)
  70. F3 = V(3)
  71. ENDIF
  72. *
  73. MINTE=IPTINT
  74. C* SEGACT,MINTE <- ACTIF EN E/S (NON MODIFIE)
  75. NBPGAU=POIGAU(/1)
  76. NBGM1 =NBPGAU-1
  77. *
  78. MELEME=IPMAIL
  79. C* SEGACT,MELEME <- ACTIF EN E/S (NON MODIFIE)
  80. NBPTEL = NUM(/1)
  81. NBELEM = NUM(/2)
  82. *
  83. * BOUCLE SUR LES ELEMENTS
  84. *
  85. DO 1000 IB=1,NBELEM
  86. *
  87. CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IB,XE)
  88. *
  89. * MATRICE DE PASSAGE ET COORDONNEES LOCALES
  90. *
  91. CALL CQ4LOC(XE,XEL,BPSS,IERR,0)
  92. *
  93. * MISE A 0 DU VECTEUR FORCE
  94. *
  95. DO I = 1, 24
  96. FTLOC(I)=0.D0
  97. ENDDO
  98. *
  99. * INTEGRATION NUMERIQUE : IGAU NUMERO DU POINT DE GAUSS
  100. * IA NUMERO D UN NOEUD
  101. *
  102. IF (IPVECT.EQ.0) THEN
  103. IF (MELVA1.NE.0) IBMN1 = MIN(IB,IBM1)
  104. IF (MELVA2.NE.0) IBMN2 = MIN(IB,IBM2)
  105. IF (MELVA3.NE.0) IBMN3 = MIN(IB,IBM3)
  106. ENDIF
  107.  
  108. DO 200 IGAU=1,NBGM1
  109. *
  110. IF (IPVECT.EQ.0) THEN
  111. IF (MELVA1.NE.0) THEN
  112. IGMN = MIN(IGAU,IGM1)
  113. F1 = MELVA1.VELCHE(IGMN,IBMN1)
  114. ENDIF
  115. IF (MELVA2.NE.0) THEN
  116. IGMN = MIN(IGAU,IGM2)
  117. F2 = MELVA2.VELCHE(IGMN,IBMN2)
  118. ENDIF
  119. IF (MELVA3.NE.0) THEN
  120. IGMN = MIN(IGAU,IGM3)
  121. F3 = MELVA3.VELCHE(IGMN,IBMN3)
  122. ENDIF
  123. ENDIF
  124. *
  125. * chgt de repere des forces appliquees
  126. *
  127. F1L = BPSS(1,1)*F1 + BPSS(1,2)*F2 + BPSS(1,3)*F3
  128. F2L = BPSS(2,1)*F1 + BPSS(2,2)*F2 + BPSS(2,3)*F3
  129. F3L = BPSS(3,1)*F1 + BPSS(3,2)*F2 + BPSS(3,3)*F3
  130. *
  131. DO 210 NP = 1, NBPTEL
  132. SHP(1,NP) = SHPTOT(1,NP,IGAU)
  133. SHP(2,NP) = SHPTOT(2,NP,IGAU)
  134. SHP(3,NP) = SHPTOT(3,NP,IGAU)
  135. 210 CONTINUE
  136. CALL JACOBI(XEL,SHP,2,NBPTEL,DJAC)
  137. DJAC = DJAC*POIGAU(IGAU)
  138. *
  139. DJAC1 = DJAC*F1L
  140. DJAC2 = DJAC*F2L
  141. DJAC3 = DJAC*F3L
  142. *
  143. DO 250 NP = 1, NBPTEL
  144. IC1=(NP-1)*6+1
  145. IC2=IC1 + 1
  146. IC3=IC2 + 1
  147. FTLOC(IC1)=FTLOC(IC1)+SHP(1,NP)*DJAC1
  148. FTLOC(IC2)=FTLOC(IC2)+SHP(1,NP)*DJAC2
  149. FTLOC(IC3)=FTLOC(IC3)+SHP(1,NP)*DJAC3
  150. 250 CONTINUE
  151. 200 CONTINUE
  152. *
  153. * CHANGEMENT DE REPERE
  154. *
  155. CALL TRPOSE(BPSS)
  156. CALL MATVEC(FTLOC,FTGLO,BPSS,8)
  157. *
  158. MPTVAL=IVAFOR
  159. IE=0
  160. DO 560 IC=1,4
  161. DO 560 ID=1,6
  162. IE=IE+1
  163. MELVAL=IVAL(ID)
  164. VELCHE(IC,IB)=FTGLO(IE)
  165. 560 CONTINUE
  166.  
  167. 1000 CONTINUE
  168.  
  169. IF (IPVECT.EQ.0) THEN
  170. IF (MELVA1.NE.0) SEGDES,MELVA1
  171. IF (MELVA2.NE.0) SEGDES,MELVA2
  172. IF (MELVA3.NE.0) SEGDES,MELVA3
  173. ENDIF
  174. C* SEGDES,MINTE
  175. C* SEGDES,MELEME
  176.  
  177. RETURN
  178. END
  179.  
  180.  
  181.  

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