Télécharger la plaquette Cast3M


fr en

Télécharger fscoq4.eso

Retour à la liste

Numérotation des lignes : 

fscoq4

  1. C FSCOQ4    SOURCE    OF166741  25/02/21    21:17:02     12166          
  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 PPARAM
  29. -INC CCOPTIO
  30.  
  31. -INC SMCHAML
  32. -INC SMELEME
  33. -INC SMINTE
  34. -INC SMCOORD
  35.  
  36. -INC TMPTVAL
  37.  
  38.       DIMENSION IPT(*), V(*)
  39.  
  40.       DIMENSION XE(3,4),XEL(3,4),BPSS(3,3),SHP(6,4),FTLOC(24),FTGLO(24)
  41.  
  42.       MELVA1 = IPT(1)
  43.       MELVA2 = IPT(2)
  44.       MELVA3 = IPT(3)
  45.       IF (IPVECT.EQ.0) THEN
  46.         IF (MELVA1.NE.0) THEN
  47.           SEGACT,MELVA1
  48.           IGM1 = MELVA1.VELCHE(/1)
  49.           IBM1 = MELVA1.VELCHE(/2)
  50.         ENDIF
  51.         IF (MELVA2.NE.0) THEN
  52.           SEGACT,MELVA2
  53.           IGM2 = MELVA2.VELCHE(/1)
  54.           IBM2 = MELVA2.VELCHE(/2)
  55.         ENDIF
  56.         IF (MELVA3.NE.0) THEN
  57.           SEGACT,MELVA3
  58.           IGM3 = MELVA3.VELCHE(/1)
  59.           IBM3 = MELVA3.VELCHE(/2)
  60.         ENDIF
  61.         F1 = 0.D0
  62.         F2 = 0.D0
  63.         F3 = 0.D0
  64.       ELSE
  65.         F1 = V(1)
  66.         F2 = V(2)
  67.         F3 = V(3)
  68.       ENDIF
  69. *
  70.       MINTE=IPTINT
  71. C*      SEGACT,MINTE           <- ACTIF EN E/S (NON MODIFIE)
  72.       NBPGAU=POIGAU(/1)
  73.       NBGM1 =NBPGAU-1
  74. *
  75.       MELEME=IPMAIL
  76. C*      SEGACT,MELEME           <- ACTIF EN E/S (NON MODIFIE)
  77.       NBPTEL = NUM(/1)
  78.       NBELEM = NUM(/2)
  79. *
  80. *     BOUCLE SUR LES ELEMENTS
  81. *
  82.       DO 1000 IB=1,NBELEM
  83. *
  84.         CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IB,XE)
  85. *
  86. *       MATRICE DE PASSAGE  ET COORDONNEES LOCALES
  87. *
  88.         CALL CQ4LOC(XE,XEL,BPSS,IERR,0)
  89. *
  90. *       MISE A 0 DU VECTEUR FORCE
  91. *
  92.         DO I = 1, 24
  93.           FTLOC(I)=0.D0
  94.         ENDDO
  95. *
  96. *        INTEGRATION NUMERIQUE : IGAU NUMERO DU POINT DE GAUSS
  97. *                                IA NUMERO D UN NOEUD
  98. *
  99.         IF (IPVECT.EQ.0) THEN
  100.           IF (MELVA1.NE.0) IBMN1 = MIN(IB,IBM1)
  101.           IF (MELVA2.NE.0) IBMN2 = MIN(IB,IBM2)
  102.           IF (MELVA3.NE.0) IBMN3 = MIN(IB,IBM3)
  103.         ENDIF
  104.  
  105.         DO 200 IGAU=1,NBGM1
  106. *
  107.           IF (IPVECT.EQ.0) THEN
  108.             IF (MELVA1.NE.0) THEN
  109.               IGMN = MIN(IGAU,IGM1)
  110.               F1 = MELVA1.VELCHE(IGMN,IBMN1)
  111.             ENDIF
  112.             IF (MELVA2.NE.0) THEN
  113.               IGMN = MIN(IGAU,IGM2)
  114.               F2 = MELVA2.VELCHE(IGMN,IBMN2)
  115.             ENDIF
  116.             IF (MELVA3.NE.0) THEN
  117.               IGMN = MIN(IGAU,IGM3)
  118.               F3 = MELVA3.VELCHE(IGMN,IBMN3)
  119.             ENDIF
  120.           ENDIF
  121. *
  122. *   chgt de repere des forces appliquees
  123. *
  124.           F1L = BPSS(1,1)*F1 + BPSS(1,2)*F2 + BPSS(1,3)*F3
  125.           F2L = BPSS(2,1)*F1 + BPSS(2,2)*F2 + BPSS(2,3)*F3
  126.           F3L = BPSS(3,1)*F1 + BPSS(3,2)*F2 + BPSS(3,3)*F3
  127. *
  128.           DO 210 NP = 1, NBPTEL
  129.             SHP(1,NP) = SHPTOT(1,NP,IGAU)
  130.             SHP(2,NP) = SHPTOT(2,NP,IGAU)
  131.             SHP(3,NP) = SHPTOT(3,NP,IGAU)
  132.  210      CONTINUE
  133.           CALL JACOBI(XEL,SHP,2,NBPTEL,DJAC)
  134.           DJAC = DJAC*POIGAU(IGAU)
  135. *
  136.           DJAC1 = DJAC*F1L
  137.           DJAC2 = DJAC*F2L
  138.           DJAC3 = DJAC*F3L
  139. *
  140.           DO 250 NP = 1, NBPTEL
  141.             IC1=(NP-1)*6+1
  142.             IC2=IC1 + 1
  143.             IC3=IC2 + 1
  144.             FTLOC(IC1)=FTLOC(IC1)+SHP(1,NP)*DJAC1
  145.             FTLOC(IC2)=FTLOC(IC2)+SHP(1,NP)*DJAC2
  146.             FTLOC(IC3)=FTLOC(IC3)+SHP(1,NP)*DJAC3
  147.  250      CONTINUE
  148.  200    CONTINUE
  149. *
  150. *     CHANGEMENT DE REPERE
  151. *
  152.         CALL TRPOSE(BPSS)
  153.         CALL MATVEC(FTLOC,FTGLO,BPSS,8)
  154. *
  155.         MPTVAL=IVAFOR
  156.         IE=0
  157.         DO 560 IC=1,4
  158.           DO 560 ID=1,6
  159.             IE=IE+1
  160.             MELVAL=IVAL(ID)
  161.             VELCHE(IC,IB)=FTGLO(IE)
  162.  560    CONTINUE
  163.  
  164.  1000 CONTINUE
  165.  
  166.       IF (IPVECT.EQ.0) THEN
  167.         IF (MELVA1.NE.0) SEGDES,MELVA1
  168.         IF (MELVA2.NE.0) SEGDES,MELVA2
  169.         IF (MELVA3.NE.0) SEGDES,MELVA3
  170.       ENDIF
  171. C*      SEGDES,MINTE
  172. C*      SEGDES,MELEME
  173.  
  174.       RETURN
  175.       END
  176.  
  177.  
  178.  

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