Télécharger la plaquette Cast3M


fr en

Télécharger fpcoq4.eso

Retour à la liste

Numérotation des lignes : 

fpcoq4

  1. C FPCOQ4    SOURCE    OF166741  25/02/21    21:16:34     12166          
  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 PPARAM
  26. -INC CCOPTIO
  27.  
  28. -INC SMCHAML
  29. -INC SMELEME
  30. -INC SMINTE
  31. -INC SMCOORD
  32.  
  33. -INC TMPTVAL
  34.  
  35.       DIMENSION   XE(3,4),XEL(3,4),BPSS(3,3)
  36.       DIMENSION  SHP(6,4),FTLOC(24),FTGLO(24)
  37. *
  38.       MELVA1=IPTVPR
  39. *
  40.       MINTE=IPTINT
  41. C*    SEGACT MINTE                               <- ACTIF EN E/S
  42.       NBPGAU=POIGAU(/1)
  43.       NBGM1 =NBPGAU-1
  44. *
  45.       MELEME=IPMAIL
  46. *
  47.       NBPTEL=NUM(/1)
  48.       NBELEM=NUM(/2)
  49. *
  50.       SEGACT MCOORD
  51. *
  52. *     BOUCLE SUR LES ELEMENTS
  53. *
  54.       DO 1000 IB=1,NBELEM
  55.          CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IB,XE)
  56. *
  57. *        MATRICE DE PASSAGE  ET COORDONNEES LOCALES
  58. *
  59.          CALL CQ4LOC(XE,XEL,BPSS,IERR,0)
  60.          CALL TRPOSE(BPSS)
  61. *
  62. *        MISE A 0 DU VECTEUR FORCE
  63. *
  64.          DO 100 I=1,24
  65.  100     FTLOC(I)=0.D0
  66. *
  67. *        INTEGRATION NUMERIQUE : IGAU NUMERO DU POINT DE GAUSS
  68. *                                IA NUMERO D UN NOEUD
  69. *
  70.          IBMN=MIN(IB,MELVA1.VELCHE(/2))
  71.          DO 200 IGAU=1,NBGM1
  72.             IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
  73.             PRE=MELVA1.VELCHE(IGMN,IBMN)
  74.             DO 500 IA  =1,NBPTEL
  75.                SHP(1,IA)=SHPTOT(1,IA,IGAU)
  76.                SHP(2,IA)=SHPTOT(2,IA,IGAU)
  77.                SHP(3,IA)=SHPTOT(3,IA,IGAU)
  78.  500        CONTINUE
  79.             CALL JACOBI(XEL,SHP,2,NBPTEL,DJAC)
  80. *
  81.             DJAC=DJAC*POIGAU(IGAU)*PRE
  82.             DO 550 NP=1,NBPTEL
  83.                IC =(NP-1)*6+3
  84.                FTLOC(IC)=FTLOC(IC)+SHP(1,NP)*DJAC
  85.  550        CONTINUE
  86.  200     CONTINUE
  87. *
  88. *     CHANGEMENT DE REPERE
  89. *
  90.          CALL MATVEC(FTLOC,FTGLO,BPSS,8)
  91.          IE=0
  92.          MPTVAL=IVAFOR
  93.          DO 560 IC=1,4
  94.             DO 560 ID=1,6
  95.                IE=IE+1
  96.                MELVAL=IVAL(ID)
  97.                VELCHE(IC,IB)=FTGLO(IE)
  98.  560     CONTINUE
  99.  1000 CONTINUE
  100. *
  101. *  Segment supprime dans fpcoqu.eso
  102. C*      SEGSUP MELVA1
  103. C*    SEGDES MINTE                               <- ACTIF EN E/S
  104. *
  105.       RETURN
  106.       END
  107.  
  108.  
  109.  

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