Télécharger la plaquette Cast3M


fr en

Télécharger fscoq8.eso

Retour à la liste

Numérotation des lignes : 

fscoq8

  1. C FSCOQ8    SOURCE    OF166741  25/02/21    21:17:03     12166          
  2.  
  3.       SUBROUTINE FSCOQ8(IPT,IPMAIL,IPTINT,IPVECT,VEC,IVACAR,
  4.      &                                        IPTNOE,IVAFOR)
  5. *______________________________________________________________________
  6. *
  7. *   CALCULE LES FORCES SURFACIQUES AUX NOEUDS DES COQUES COQ8, COQ6
  8. *
  9. *
  10. *  ENTREES :
  11. *  ---------
  12. *
  13. *       IPT      TABLEAU DE POINTEURS SUR MPTVAL CONTENANT LES FORCES
  14. *                APPLIQUEES
  15. *       IPMAIL  POINTEUR SUR LE MAILLAGE
  16. *       IPTINT  POINTEUR SUR LE CHAMELEM DE L'INTEGRATION
  17. *       IPVECT  POINTEUR SUR LE VECTEUR REPRESENTANT LA FORCE
  18. *       VEC     VECTEUR REPRESENTANT LA FORCE
  19. *       IVACAR  POINTEUR SUR UN SEGMENT MPTVAL CONCERNANT LES CARAC-
  20. *               TERISTIQUES (EPAISSEUR AUX NOEUDS)
  21. *       IPTNOE  POINTEUR SUR L'ALIAS DU CHAMELEM D'INTEGRATION CONTENANT
  22. *                LES FONCTIONS DE FORME AUX NOEUDS
  23. *       IVAFOR  POINTEUR SUR UN MPTVAL ET MELVALS ASSOCIEES AUX FORCES
  24. *                ET MOMENTS AUX NOEUDS
  25. *
  26. *_______________________________________________________________________
  27. *
  28.       IMPLICIT INTEGER(I-N)
  29.       IMPLICIT REAL*8(A-H,O-Z)
  30.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33.  
  34. -INC SMCHAML
  35. -INC SMELEME
  36. -INC SMINTE
  37. -INC SMCOORD
  38.  
  39. -INC TMPTVAL
  40.  
  41.       DIMENSION IPT(*),VEC(*)
  42.  
  43.       DIMENSION TH(8),XJ(3,3),TXR(3,3,8),XE(3,8)
  44.  
  45.       MELVA1 = IPT(1)
  46.       MELVA2 = IPT(2)
  47.       MELVA3 = IPT(3)
  48.       IF (IPVECT.EQ.0) THEN
  49.         IBM1 = 0
  50.         IF (MELVA1.NE.0) THEN
  51.           SEGACT,MELVA1
  52.           IGM1 = MELVA1.VELCHE(/1)
  53.           IBM1 = MELVA1.VELCHE(/2)
  54.         ENDIF
  55.         IBM2 = 0
  56.         IF (MELVA2.NE.0) THEN
  57.           SEGACT,MELVA2
  58.           IGM2 = MELVA2.VELCHE(/1)
  59.           IBM2 = MELVA2.VELCHE(/2)
  60.         ENDIF
  61.         IBM3 = 0
  62.         IF (MELVA3.NE.0) THEN
  63.           SEGACT,MELVA3
  64.           IGM3 = MELVA3.VELCHE(/1)
  65.           IBM3 = MELVA3.VELCHE(/2)
  66.         ENDIF
  67.         F1 = 0.D0
  68.         F2 = 0.D0
  69.         F3 = 0.D0
  70.       ELSE
  71.         F1 = VEC(1)
  72.         F2 = VEC(2)
  73.         F3 = VEC(3)
  74.       ENDIF
  75. *
  76.       MINTE=IPTINT
  77. C*      SEGACT,MINTE                               <- ACTIF EN E/S
  78.       NBPGAU=POIGAU(/1)
  79.       NBGAU2=NBPGAU/2
  80. *
  81.       MINTE1=IPTNOE
  82.       SEGACT,MINTE1
  83. *
  84.       MELEME=IPMAIL
  85. C*      SEGACT,MELEME                              <- ACTIF EN E/S
  86.       NBNN  = NUM(/1)
  87.       NBELEM= NUM(/2)
  88. C*
  89. C*  PREPARATION DE DONNEES POUR LE CALCUL DE L'EPAISSEUR D'UN ELEMENT
  90. C*
  91.       MPTVAL = IVACAR
  92.       MELVEP = IVAL(1)
  93.       MELVAL = MELVEP
  94. C*      SEGACT,MELVAL                              <- ACTIF EN E/S
  95.       IGEP = VELCHE(/1)
  96.       IBEP = VELCHE(/2)
  97. C*      IF (IGEP.LT.1) THEN
  98. C*        WRITE(IOMP,*) 'ERREUR : FSCOQ8 - IGEP'
  99. C*        CALL ERREUR(5)
  100. C*        RETURN
  101. C*      ENDIF
  102. *
  103.       MPTVAL = IVAFOR
  104. *
  105. *     BOUCLE SUR LES ELEMENTS
  106. *
  107.       DO 1 IB = 1, NBELEM
  108. *
  109. *       CALCUL DE L EPAISSEUR MOYENNE
  110. *       CALCUL DE TH(IPTELE)
  111. *
  112.         MELVAL = MELVEP
  113.         IBMN = MIN(IB,IBEP)
  114.         EPAI = VELCHE(1,IBMN)
  115.         IF (IGEP.GT.1) THEN
  116.           DO i = 2, IGEP
  117.             EPAI = EPAI + VELCHE(i,IBMN)
  118.           ENDDO
  119.           EPAI = EPAI / IGEP
  120.         ENDIF
  121. *      ON STOCKE L'EPAISSEUR MOYENNE A CHAQUE NOEUD (UTILE POUR LES CALCULS)
  122.         DO i = 1, NBNN
  123.           TH(i) = EPAI
  124.         ENDDO
  125. *
  126. *        DETERMINATION DES REPERES LOCAUX AUX NOEUDS
  127. *
  128.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  129.         CALL CQ8LOC(XE,NBNN,MINTE1.SHPTOT,TXR,irr)
  130. *
  131.         IF (IPVECT.EQ.0) THEN
  132.           IF (MELVA1.NE.0) IBMN1 = MIN(IB,IBM1)
  133.           IF (MELVA2.NE.0) IBMN2 = MIN(IB,IBM2)
  134.           IF (MELVA3.NE.0) IBMN3 = MIN(IB,IBM3)
  135.         ENDIF
  136. *
  137. *       BOUCLE SUR LES POINTS DE GAUSS
  138. *
  139.         DO 10 IGAU = 1, NBGAU2
  140. *
  141.           IF (IPVECT.EQ.0) THEN
  142.             IF (MELVA1.NE.0) THEN
  143.               IGMN = MIN(IGAU,IGM1)
  144.               F1 = MELVA1.VELCHE(IGMN,IBMN1)
  145.             ENDIF
  146.             IF (MELVA2.NE.0) THEN
  147.               IGMN = MIN(IGAU,IGM2)
  148.               F2 = MELVA2.VELCHE(IGMN,IBMN2)
  149.             ENDIF
  150.             IF (MELVA3.NE.0) THEN
  151.               IGMN = MIN(IGAU,IGM3)
  152.               F3 = MELVA3.VELCHE(IGMN,IBMN3)
  153.             ENDIF
  154.           ENDIF
  155. *
  156. *           VECTEUR NORMAL A LA SURFACE DE L ELEMENT AU PT DE GAUSS IGAU
  157. *
  158.           CALL COQ8JC(IGAU,NBNN,1.D0,XE,TH,TXR,SHPTOT,XJ,DET,irr)
  159. *
  160.           VG_1 = XJ(1,2)*XJ(2,3) - XJ(2,2)*XJ(1,3)
  161.           VG_2 = XJ(1,3)*XJ(2,1) - XJ(2,3)*XJ(1,1)
  162.           VG_3 = XJ(1,1)*XJ(2,2) - XJ(2,1)*XJ(1,2)
  163.           VN = SQRT( VG_1*VG_1 + VG_2*VG_2 +  VG_3*VG_3 )
  164.           VG_1 = VG_1 / VN
  165.           VG_2 = VG_2 / VN
  166.           VG_3 = VG_3 / VN
  167. *
  168.           SURFP =    VN * POIGAU(IGAU)
  169.           POI2P = 0.5D0 * POIGAU(IGAU)
  170. *
  171. *           BOUCLE SUR NOEUDS DE L'ELEMENT
  172. *
  173. *
  174.           DO 20 J = 1, NBNN
  175. *
  176.             VQ_1 = TXR(1,1,J)
  177.             VQ_2 = TXR(2,1,J)
  178.             VQ_3 = TXR(3,1,J)
  179.             VE_1 = TXR(1,2,J)
  180.             VE_2 = TXR(2,2,J)
  181.             VE_3 = TXR(3,2,J)
  182. *
  183. *  Matrice de changement de repere : XJij
  184. *
  185.             XJ11 = 0.D0
  186.             XJ12 = VQ_1*VE_2 - VQ_2*VE_1
  187.             XJ13 = VQ_1*VE_3 - VE_1*VQ_3
  188.             XJ21 = -XJ12
  189.             XJ22 = 0.D0
  190.             XJ23 = VQ_2*VE_3 - VE_2*VQ_3
  191.             XJ31 = -XJ13
  192.             XJ32 = -XJ23
  193.             XJ33 = 0.D0
  194. *
  195. *  Chgt de repere du vecteur force (F1,F2,F3) : global -> local
  196. *
  197.             F1L = VQ_1*F1 + VQ_2*F2 + VQ_3*F3
  198.             F2L = VE_1*F1 + VE_2*F2 + VE_3*F3
  199.             F3L = VG_1*F1 + VG_2*F2 + VG_3*F3
  200. *
  201. *  FORCES AUX NOEUDS
  202. *
  203.             WGTM = SURFP * SHPTOT(1,J,IGAU)
  204. *
  205.             MELVAL = IVAL(1)
  206.             VELCHE(J,IB) =   VELCHE(J,IB)
  207.      &                     + WGTM * (VG_1*F3L + VQ_1*F1L + VE_1*F2L)
  208.  
  209.             MELVAL = IVAL(2)
  210.             VELCHE(J,IB) =   VELCHE(J,IB)
  211.      &                     + WGTM * (VG_2*F3L + VQ_2*F1L + VE_2*F2L)
  212.  
  213.             MELVAL = IVAL(3)
  214.             VELCHE(J,IB) =   VELCHE(J,IB)
  215.      &                     + WGTM * (VG_3*F3L + VQ_3*F1L + VE_3*F2L)
  216. *
  217. *                                                (V2JT)
  218. *  MOMENTS AUX NDS = WT*P*TH(J)* (V1J,-V2J)(V1JT) *(VNGAU)
  219. *              VALEURS DES MOMENTS AUX NOEUDS
  220. *  Chgt de repere : local -> global
  221. *
  222.             WGTM = POI2P * TH(J) * SHPTOT(1,J,IGAU)
  223. *
  224.             MELVAL = IVAL(4)
  225.             VGG = XJ11*VG_1 + XJ21*VG_2 + XJ31*VG_3
  226.             VQG = XJ11*VQ_1 + XJ21*VQ_2 + XJ31*VQ_3
  227.             VEG = XJ11*VE_1 + XJ21*VE_2 + XJ31*VE_3
  228.             VELCHE(J,IB) =   VELCHE(J,IB)
  229.      &                     + WGTM * (VGG*F3L + VQG*F1L + VEG*F2L)
  230.             MELVAL=IVAL(5)
  231.             VGG = XJ12*VG_1 + XJ22*VG_2 + XJ32*VG_3
  232.             VQG = XJ12*VQ_1 + XJ22*VQ_2 + XJ32*VQ_3
  233.             VEG = XJ12*VE_1 + XJ22*VE_2 + XJ32*VE_3
  234.             VELCHE(J,IB) =   VELCHE(J,IB)
  235.      &                     + WGTM * (VGG*F3L+ VQG*F1L + VEG*F2L)
  236.  
  237.             MELVAL=IVAL(6)
  238.             VGG = XJ13*VG_1 + XJ23*VG_2 + XJ33*VG_3
  239.             VQG = XJ13*VQ_1 + XJ23*VQ_2 + XJ33*VQ_3
  240.             VEG = XJ13*VE_1 + XJ23*VE_2 + XJ33*VE_3
  241.             VELCHE(J,IB) =   VELCHE(J,IB)
  242.      &                     + WGTM * (VGG*F3L + VQG*F1L + VEG*F2L)
  243.    20     CONTINUE
  244.  
  245.    10   CONTINUE
  246.  
  247.    1  CONTINUE
  248.  
  249. C*    SEGDES,MELEME                              <- ACTIF EN E/S
  250. C*    SEGDES,MINTE                               <- ACTIF EN E/S
  251.       SEGDES,MINTE1
  252.       IF (IPVECT.EQ.0) THEN
  253.         IF (MELVA1.NE.0) SEGDES,MELVA1
  254.         IF (MELVA2.NE.0) SEGDES,MELVA2
  255.         IF (MELVA3.NE.0) SEGDES,MELVA3
  256.       ENDIF
  257.  
  258.       RETURN
  259.       END
  260.  
  261.  
  262.  

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