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

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