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

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