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    CB215821  26/08/24    21:16:38     12622          
  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.          FTLOC(I)=0.D0
  66.   100    CONTINUE
  67. *
  68. *        INTEGRATION NUMERIQUE : IGAU NUMERO DU POINT DE GAUSS
  69. *                                IA NUMERO D UN NOEUD
  70. *
  71.          IBMN=MIN(IB,MELVA1.VELCHE(/2))
  72.          DO 200 IGAU=1,NBGM1
  73.             IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
  74.             PRE=MELVA1.VELCHE(IGMN,IBMN)
  75.             DO 500 IA  =1,NBPTEL
  76.                SHP(1,IA)=SHPTOT(1,IA,IGAU)
  77.                SHP(2,IA)=SHPTOT(2,IA,IGAU)
  78.                SHP(3,IA)=SHPTOT(3,IA,IGAU)
  79.  500        CONTINUE
  80.             CALL JACOBI(XEL,SHP,2,NBPTEL,DJAC)
  81. *
  82.             DJAC=DJAC*POIGAU(IGAU)*PRE
  83.             DO 550 NP=1,NBPTEL
  84.                IC =(NP-1)*6+3
  85.                FTLOC(IC)=FTLOC(IC)+SHP(1,NP)*DJAC
  86.  550        CONTINUE
  87.  200     CONTINUE
  88. *
  89. *     CHANGEMENT DE REPERE
  90. *
  91.          CALL MATVEC(FTLOC,FTGLO,BPSS,8)
  92.          IE=0
  93.          MPTVAL=IVAFOR
  94.          DO 1001 IC=1,4
  95.             DO 560 ID=1,6
  96.                IE=IE+1
  97.                MELVAL=IVAL(ID)
  98.                VELCHE(IC,IB)=FTGLO(IE)
  99.  560     CONTINUE
  100.  1001    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