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

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