Télécharger la plaquette Cast3M


fr en

Télécharger fplisp.eso

Retour à la liste

Numérotation des lignes : 

fplisp

  1. C FPLISP    SOURCE    OF166741  25/02/21    21:16:40     12166          
  2.       SUBROUTINE FPLISP(IPTVPR,IPTGEO,IPTINT,IVACAR,IVAFOR)
  3. C_____________________________________________________________________
  4. C
  5. C     CALCULE LES FORCES DE PRESSION DANS LE LINESPRING
  6. C
  7. C    ENTREES :
  8. C    ---------
  9. C
  10. C   IPTVPR   POINTEUR SUR LE MELVAL CONTENANT LES PRESSIONS
  11. C   IPTGEO   POINTEUR SUR LE MAILLAGE
  12. C   IPTINT   POINTEUR SUR MINTE
  13. C   IVACAR   POINTEUR SUR MPTVAL DE CARACTERISTIQUE
  14. C   IVAFOR   POINTEUR SUR MPTVAL DE FORCE
  15. C
  16. C    EBERSOLT MAI 85   J UTILISE DFLOAT ET SQRT
  17. C    PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 21 09 90
  18. C
  19. C_____________________________________________________________________
  20. C
  21.       IMPLICIT INTEGER(I-N)
  22.       IMPLICIT REAL*8(A-H,O-Z)
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26.  
  27. -INC SMINTE
  28. -INC SMCHAML
  29. -INC SMELEME
  30. -INC SMCOORD
  31.  
  32. -INC TMPTVAL
  33.  
  34.       DIMENSION BPSS(3,3),XE(3,4),XEL(3,3),V1(3),V2(3),H1(3),H2(3)
  35. C
  36.       DATA X774/.774596669241483D0/
  37.       DATA UN,UNDEMI,ZERO/1.D0,.5D0,0.D0/
  38. C
  39. C     ON INITIALISE LES FONCTIONS DE FORME
  40. C
  41.       H1(1) =(UN-X774)*UNDEMI
  42.       H1(2) = UNDEMI
  43.       H1(3) =(UN+X774)*UNDEMI
  44.       H2(1) = H1(3)
  45.       H2(2) = UNDEMI
  46.       H2(3) = H1(1)
  47. C
  48.       MELVA1=IPTVPR
  49. C
  50.       MELEME=IPTGEO
  51.       NBNN  =NUM(/1)
  52.       NBELEM=NUM(/2)
  53. C
  54.       MINTE =IPTINT
  55.       SEGACT MINTE
  56.       NBNO  =SHPTOT(/2)
  57.       NBPGAU=SHPTOT(/3)
  58. C
  59. C     BOUCLE SUR LES ELEMENTS
  60. C
  61.       DO 100   IA=1,NBELEM
  62. C
  63. C        ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  64. C
  65.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IA,XE)
  66. C
  67. C        ON RECUPERE LES VECTEURS ORIENTANT LE LINESPRING
  68. C        AINSI QUE LA LONGUEUR DU LINESPRING
  69. C
  70.          XLONG= ZERO
  71.          MPTVAL=IVACAR
  72.          DO 110 IB=1,3
  73.             MELVAL=IVAL(2+IB)
  74.             IBMN=MIN(IA,VELCHE(/2))
  75.             V1(IB)=VELCHE(1,IBMN)
  76.             V2(IB)=VELCHE(1,IBMN)
  77.             XLONG =XLONG +(XE(IB,1)-XE(IB,2))*(XE(IB,1)-XE(IB,2))
  78.  110     CONTINUE
  79.          XLONG = SQRT(XLONG)
  80. C
  81. C        AINSI QUE L EPAISSEUR
  82. C
  83.          EPAISS=ZERO
  84.          DO 120 IB=1,NBPGAU
  85.             MELVAL=IVAL(1)
  86.             IGMN=MIN(IB,VELCHE(/1))
  87.             IBMN=MIN(IA,VELCHE(/2))
  88.             EPAISS=VELCHE(IGMN,IBMN)+EPAISS
  89.  120     CONTINUE
  90.          EPAISS=EPAISS/DBLE(NBPGAU)
  91. C
  92. C        EXTRACTION DE LA MATRICE DE PASSAGE
  93. C
  94.          DO 130 IB=1,3
  95.             XEL(IB,1)=XE(IB,1)
  96.             XEL(IB,2)=XE(IB,2)
  97.             XEL(IB,3)=XE(IB,1)+(V1(IB)+V2(IB))*UNDEMI
  98.  130     CONTINUE
  99.               DO 97 II=1,3
  100.               DO 97 JJ=1,3
  101.  97           CONTINUE
  102.          CALL VPAST(XEL,BPSS)
  103. C
  104. C     ON INTEGRE LES FORCES DU  A LA PRESSION DANS LA FISSURE
  105. C
  106.          FZ1= ZERO
  107.          CX1= ZERO
  109.          CX2= ZERO
  110. C
  111. C        BOUCLE SUR LES POINTS DE GAUSS
  112. C
  113.          MPTVAL=IVACAR
  114.          DO 200 IB=1,NBPGAU
  115.             MELVAL=IVAL(2)
  116.             IGMN=MIN(IB,VELCHE(/1))
  117.             IBMN=MIN(IA,VELCHE(/2))
  118.             FISS=VELCHE(IGMN,IBMN)
  119.             IGMN=MIN(IB,MELVA1.VELCHE(/1))
  120.             IBMN=MIN(IA,MELVA1.VELCHE(/2))
  121.             PRES=MELVA1.VELCHE(IGMN,IBMN)
  122.             XX=FISS*PRES*POIGAU(IB)*XLONG*UNDEMI
  123.             FZ1= FZ1+ XX*H1(IB)
  124.             CX1= CX1+ XX*(EPAISS-FISS)*H1(IB)*UNDEMI
  125.             FZ2= FZ2+ XX*H2(IB)
  126.             CX2= CX2+ XX*(EPAISS-FISS)*H2(IB)*UNDEMI
  127.   200    CONTINUE
  128. C
  129. C        CHANGEMENT DE REPERE
  130. C
  131.          MPTVAL=IVAFOR
  132.          MELVAL=IVAL(1)
  133.          VELCHE(1,IA)=FZ1*BPSS(3,1)
  134.          VELCHE(2,IA)=FZ2*BPSS(3,1)
  135. C
  136.          MELVAL=IVAL(2)
  137.          VELCHE(1,IA)=FZ1*BPSS(3,2)
  138.          VELCHE(2,IA)=FZ2*BPSS(3,2)
  139. C
  140.          MELVAL=IVAL(3)
  141.          VELCHE(1,IA)=FZ1*BPSS(3,3)
  142.          VELCHE(2,IA)=FZ2*BPSS(3,3)
  143. C
  144.          MELVAL=IVAL(4)
  145.          VELCHE(1,IA)=CX1*BPSS(1,1)
  146.          VELCHE(2,IA)=CX2*BPSS(1,1)
  147. C
  148.          MELVAL=IVAL(5)
  149.          VELCHE(1,IA)=CX1*BPSS(1,2)
  150.          VELCHE(2,IA)=CX2*BPSS(1,2)
  151. C
  152.          MELVAL=IVAL(6)
  153.          VELCHE(1,IA)=CX1*BPSS(1,3)
  154.          VELCHE(2,IA)=CX2*BPSS(1,3)
  155. C
  156.          MPTVAL=IVAFOR
  157.          DO 300 IB=1,6
  158.             MELVAL=IVAL(IB)
  159.             VELCHE(3,IA)=-VELCHE(2,IA)
  160.             VELCHE(4,IA)=-VELCHE(1,IA)
  161.   300    CONTINUE
  162. C
  163.   100 CONTINUE
  164. C
  165.   666 CONTINUE
  166.       SEGDES MINTE
  167.  
  168.       RETURN
  169.       END
  170.  
  171.  
  172.  

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