Télécharger fpcoq4.eso

Retour à la liste

Numérotation des lignes :

  1. C FPCOQ4 SOURCE MB234859 16/10/07 21:15:06 9121
  2. SUBROUTINE FPCOQ4(IPTVPR,IPMAIL,IPTINT,IVAFOR)
  3. *____________________________________________________________________
  4. *
  5. * CALCULE LES FORCES DE PRESSIONS SUR LES COQUES COQ4 3D
  6. *
  7. * ENTREES :
  8. * ---------
  9. *
  10. * IPTVPR MELVAL CONTENANT LES PRESSIONS APPLIQUEES
  11. * IPMAIL OBJET GEOMETRIQUE
  12. * IPTINT POINTEUR SUR UN MINTE CONTENANT LES POINTS D INTEGRATION
  13. * (SEGMENT ACTIF EN ENTREE ET EN SORTIE)
  14. * IVAFOR POINTEUR SUR UN MPTVAL ET DES MELVALS DEVANT CONTENIR
  15. * LES FORCES NODALES RESULTANTES
  16. *
  17. * G. M. GIANNUZZI SETT 86
  18. * PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 12 09 90
  19. *
  20. *____________________________________________________________________
  21. *
  22. IMPLICIT INTEGER(I-N)
  23. IMPLICIT REAL*8(A-H,O-Z)
  24. *
  25. -INC SMCHAML
  26. -INC SMELEME
  27. -INC SMINTE
  28. -INC SMCOORD
  29. -INC CCOPTIO
  30. *
  31. SEGMENT MPTVAL
  32. INTEGER IPOS(NS) ,NSOF(NS)
  33. INTEGER IVAL(NCOSOU)
  34. CHARACTER*16 TYVAL(NCOSOU)
  35. ENDSEGMENT
  36. *
  37. DIMENSION XE(3,4),XEL(3,4),BPSS(3,3)
  38. DIMENSION SHP(6,4),FTLOC(24),FTGLO(24)
  39. *
  40. MELVA1=IPTVPR
  41. *
  42. MINTE=IPTINT
  43. C* SEGACT MINTE <- ACTIF EN E/S
  44. NBPGAU=POIGAU(/1)
  45. NBGM1 =NBPGAU-1
  46. *
  47. MELEME=IPMAIL
  48. *
  49. NBPTEL=NUM(/1)
  50. NBELEM=NUM(/2)
  51. *
  52. SEGACT MCOORD
  53. *
  54. * BOUCLE SUR LES ELEMENTS
  55. *
  56. DO 1000 IB=1,NBELEM
  57. CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IB,XE)
  58. *
  59. * MATRICE DE PASSAGE ET COORDONNEES LOCALES
  60. *
  61. CALL CQ4LOC(XE,XEL,BPSS,IERR,0)
  62. CALL TRPOSE(BPSS)
  63. *
  64. * MISE A 0 DU VECTEUR FORCE
  65. *
  66. DO 100 I=1,24
  67. 100 FTLOC(I)=0.D0
  68. *
  69. * INTEGRATION NUMERIQUE : IGAU NUMERO DU POINT DE GAUSS
  70. * IA NUMERO D UN NOEUD
  71. *
  72. IBMN=MIN(IB,MELVA1.VELCHE(/2))
  73. DO 200 IGAU=1,NBGM1
  74. IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
  75. PRE=MELVA1.VELCHE(IGMN,IBMN)
  76. DO 500 IA =1,NBPTEL
  77. SHP(1,IA)=SHPTOT(1,IA,IGAU)
  78. SHP(2,IA)=SHPTOT(2,IA,IGAU)
  79. SHP(3,IA)=SHPTOT(3,IA,IGAU)
  80. 500 CONTINUE
  81. CALL JACOBI(XEL,SHP,2,NBPTEL,DJAC)
  82. *
  83. DJAC=DJAC*POIGAU(IGAU)*PRE
  84. DO 550 NP=1,NBPTEL
  85. IC =(NP-1)*6+3
  86. FTLOC(IC)=FTLOC(IC)+SHP(1,NP)*DJAC
  87. 550 CONTINUE
  88. 200 CONTINUE
  89. *
  90. * CHANGEMENT DE REPERE
  91. *
  92. CALL MATVEC(FTLOC,FTGLO,BPSS,8)
  93. IE=0
  94. MPTVAL=IVAFOR
  95. DO 560 IC=1,4
  96. DO 560 ID=1,6
  97. IE=IE+1
  98. MELVAL=IVAL(ID)
  99. VELCHE(IC,IB)=FTGLO(IE)
  100. 560 CONTINUE
  101. 1000 CONTINUE
  102. *
  103. * Segment supprime dans fpcoqu.eso
  104. C* SEGSUP MELVA1
  105. C* SEGDES MINTE <- ACTIF EN E/S
  106. *
  107. RETURN
  108. END
  109.  
  110.  
  111.  
  112.  

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