Télécharger la plaquette Cast3M


fr en

Télécharger pb663.eso

Retour à la liste

Numérotation des lignes : 

pb663

  1. C PB663     SOURCE    CHAT      05/01/13    02:10:51     5004
  2.       SUBROUTINE PB663(X,Y,Z,PG,FN,GR,FM,GM,ND,NP,MP,NGG,NPG,NOM2)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C************************************************************************
  6. C
  7. C     CALCULE LES FONCTIONS DE FORME D'UN : Iso-Q2 (iso P1/P0 nc) PR18
  8. C
  9. C                                              P4 equation du plan zeta=0
  10. C                                              P5 equation du plan zeta=1
  11. C    ^ zeta                                             etc
  12. C    |     14                  ^ eta     |X3  3
  13. C    |     / \                /          |Y3  o
  14. C    |    /   \              /                |\
  15. C    |  15_____\13          /                 | \
  16. C    |  / \    /\          /              P3  |  \  P2
  17. C    | /   \  /  \        /                   |   \
  18. C    |/_____\/____\      /                    |    \
  19. C    10     11    12    /                     |     \
  20. C    |                 /                    1 o______o 2
  21. C    |      9         /                  |X1            |X2
  22. C    |     / \       /                   |Y1     P1     |Y2
  23. C    |    /   \     /
  24. C    |  18_____17
  25. C    |  / \    /\                     XI abcisse intersection P2 et ksi
  26. C    | /   \  /  \                    YI ordonnée intersection P2 et eta
  27. C    |/_____\/____\
  28. C    7      16     8
  29. C    |       /                   fct de formes N1=P2*P5/F1C
  30. C    |      5                                  tel que N1=1 au pt 1
  31. C    |     / \
  32. C    |    /   \
  33. C    |   6_____\4
  34. C    |  / \    /\
  35. C    | /   \  /  \
  36. C    |/_____\/____\ ____________________>ksi
  37. C    1      2      3
  38. C
  39. C
  40. C************************************************************************
  41.  
  42.       CHARACTER*4 NOM2
  43.       REAL*8 X(NPG),Y(NPG),Z(NPG)
  44.       DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
  45.       DIMENSION FM(MP,NPG),GM(ND,MP,NPG)
  46.       DIMENSION U(5),H(5),XA(3),XB(3),XC(3),XD(3)
  47.       SAVE XA,XB,XC,XD
  48.       DATA XA/3*0.25D0/,XB/0.75D0,0.25D0,0.75D0/
  49.       DATA XC/2*0.75D0,0.25D0/,XD/0.25D0,2*0.75D0/
  50.  
  51. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  52. C
  53.  
  54.       R2=SQRT(2.D0)
  55.       R22=R2*0.5D0
  56.  
  57.       DO 1 K=1,8
  58. C
  59.       IF(K.EQ.1)THEN
  60.       X1=0.D0
  61.       Y1=0.D0
  62.       X2=R22
  63.       Y2=0.D0
  64.       X3=0.D0
  65.       Y3=R22
  66.       Z1=0.D0
  67.       Z2=0.5D0
  68.       XI=R22
  69.       YI=R22
  70.       ELSEIF(K.EQ.2)THEN
  71.       X1=R22
  72.       Y1=0.D0
  73.       X2=R2
  74.       Y2=0.D0
  75.       X3=R22
  76.       Y3=R22
  77.       Z1=0.D0
  78.       Z2=0.5D0
  79.       XI=R2
  80.       YI=R2
  81.       ELSEIF(K.EQ.3)THEN
  82.       X1=0.D0
  83.       Y1=R22
  84.       X2=R22
  85.       Y2=R22
  86.       X3=0.D0
  87.       Y3=R2
  88.       Z1=0.D0
  89.       Z2=0.5D0
  90.       XI=R2
  91.       YI=R2
  92.       ELSEIF(K.EQ.4)THEN
  93.       X1=R22
  94.       Y1=R22
  95.       X2=0.D0
  96.       Y2=R22
  97.       X3=R22
  98.       Y3=0.D0
  99.       Z1=0.D0
  100.       Z2=0.5D0
  101.       XI=R22
  102.       YI=R22
  103.       ELSEIF(K.EQ.5)THEN
  104.       X1=0.D0
  105.       Y1=0.D0
  106.       X2=R22
  107.       Y2=0.D0
  108.       X3=0.D0
  109.       Y3=R22
  110.       Z1=0.5D0
  111.       Z2=1.D0
  112.       XI=R22
  113.       YI=R22
  114.       ELSEIF(K.EQ.6)THEN
  115.       X1=R22
  116.       Y1=0.D0
  117.       X2=R2
  118.       Y2=0.D0
  119.       X3=R22
  120.       Y3=R22
  121.       Z1=0.5D0
  122.       Z2=1.D0
  123.       XI=R2
  124.       YI=R2
  125.       ELSEIF(K.EQ.7)THEN
  126.       X1=0.D0
  127.       Y1=R22
  128.       X2=R22
  129.       Y2=R22
  130.       X3=0.D0
  131.       Y3=R2
  132.       Z1=0.5D0
  133.       Z2=1.D0
  134.       XI=R2
  135.       YI=R2
  136.       ELSEIF(K.EQ.8)THEN
  137.       X1=R22
  138.       Y1=R22
  139.       X2=0.D0
  140.       Y2=R22
  141.       X3=R22
  142.       Y3=0.D0
  143.       Z1=0.5D0
  144.       Z2=1.D0
  145.       XI=R22
  146.       YI=R22
  147.       ENDIF
  148.  
  149.       K0=(K-1)*NGG
  150.       CALL KHPRM(X(K0+1),Y(K0+1),Z(K0+1),PG(K0+1),NGG,
  151.      &X1,Y1,X2,Y3,Z1,Z2)
  152. C     write(6,*)' KHPRM NGG=',ngg
  153. C     write(6,1002)(x(ii),ii=1,ngg)
  154. C     write(6,1002)(y(ii),ii=1,ngg)
  155. C     write(6,1002)(z(ii),ii=1,ngg)
  156.  
  157.       P1C=Y3-Y1
  158.       P2C=X1/XI+Y1/YI-1.D0
  159.       P3C=X2-X1
  160.       P4C=Z2-Z1
  161.       P5C=Z1-Z2
  162. C     write(6,*)'PiC '
  163. C     write(6,1002)P1C,P2C,P3C,P4C,P5C
  164.  
  165.       DO 1 L=1,NGG
  166.       P1=Y(L+K0)-Y1
  167.       P2=X(L+K0)/XI+Y(L+K0)/YI-1.D0
  168.       P3=X(L+K0)-X1
  169.       P4=Z(L+K0)-Z1
  170.       P5=Z(L+K0)-Z2
  171.  
  172.       F1C=P2C*P5C
  173.       F1=P2*P5/F1C
  174.  
  175.       F2C=P3C*P5C
  176.       F2=P3*P5/F2C
  177.  
  178.       F3C=P1C*P5C
  179.       F3=P1*P5/F3C
  180.  
  181.       F4C=P2C*P4C
  182.       F4=P2*P4/F4C
  183.  
  184.       F5C=P3C*P4C
  185.       F5=P3*P4/F5C
  186.  
  187.       F6C=P1C*P4C
  188.       F6=P1*P4/F6C
  189.  
  190. C     write(6,*)'FiC'
  191. C     write(6,1002)F1C,F2C,F3C,F4C,F5C,F6C
  192.  
  193.       GX1=P5/XI/F1C
  194.       GY1=P5/YI/F1C
  195.       GZ1=P2/F1C
  196.  
  197.       GX2=P5/F2C
  198.       GY2=0.D0
  199.       GZ2=P3/F2C
  200.  
  201.       GX3=0.D0
  202.       GY3=P5/F3C
  203.       GZ3=P1/F3C
  204.  
  205.       GX4=P4/XI/F4C
  206.       GY4=P4/YI/F4C
  207.       GZ4=P2/F4C
  208.  
  209.       GX5=P4/F5C
  210.       GY5=0.D0
  211.       GZ5=P3/F5C
  212.  
  213.       GX6=0.D0
  214.       GY6=P4/F6C
  215.       GZ6=P1/F6C
  216.  
  217. C     write(6,1002)F1,f2,f3,f4,f5,f6
  218. C
  219. C     write(6,1002)gx1,gx2,gx3,gx4,gx5,gx6
  220. C     write(6,1002)gy1,gy2,gy3,gy4,gy5,gy6
  221. C     write(6,1002)gz1,gz2,gz3,gz4,gz5,gz6
  222.  
  223.       LL=K0+L
  224.  
  225.       IF(K.EQ.1)THEN
  226.  
  227.       FN( 1,LL)=F1
  228.       FN( 2,LL)=F2
  229.       FN( 6,LL)=F3
  230.       FN( 7,LL)=F4
  231.       FN(16,LL)=F5
  232.       FN(18,LL)=F6
  233.  
  234.       GR(1, 1,LL)=GX1
  235.       GR(1, 2,LL)=GX2
  236.       GR(1, 6,LL)=GX3
  237.       GR(1, 7,LL)=GX4
  238.       GR(1,16,LL)=GX5
  239.       GR(1,18,LL)=GX6
  240.  
  241.       GR(2, 1,LL)=GY1
  242.       GR(2, 2,LL)=GY2
  243.       GR(2, 6,LL)=GY3
  244.       GR(2, 7,LL)=GY4
  245.       GR(2,16,LL)=GY5
  246.       GR(2,18,LL)=GY6
  247.  
  248.       GR(3, 1,LL)=GZ1
  249.       GR(3, 2,LL)=GZ2
  250.       GR(3, 6,LL)=GZ3
  251.       GR(3, 7,LL)=GZ4
  252.       GR(3,16,LL)=GZ5
  253.       GR(3,18,LL)=GZ6
  254.  
  255.       ELSEIF(K.EQ.2)THEN
  256.  
  257.       FN( 2,LL)=F1
  258.       FN( 3,LL)=F2
  259.       FN( 4,LL)=F3
  260.       FN(16,LL)=F4
  261.       FN( 8,LL)=F5
  262.       FN(17,LL)=F6
  263.  
  264.       GR(1, 2,LL)=GX1
  265.       GR(1, 3,LL)=GX2
  266.       GR(1, 4,LL)=GX3
  267.       GR(1,16,LL)=GX4
  268.       GR(1, 8,LL)=GX5
  269.       GR(1,17,LL)=GX6
  270.  
  271.       GR(2, 2,LL)=GY1
  272.       GR(2, 3,LL)=GY2
  273.       GR(2, 4,LL)=GY3
  274.       GR(2,16,LL)=GY4
  275.       GR(2, 8,LL)=GY5
  276.       GR(2,17,LL)=GY6
  277.  
  278.       GR(3, 2,LL)=GZ1
  279.       GR(3, 3,LL)=GZ2
  280.       GR(3, 4,LL)=GZ3
  281.       GR(3,16,LL)=GZ4
  282.       GR(3, 8,LL)=GZ5
  283.       GR(3,17,LL)=GZ6
  284.  
  285.       ELSEIF(K.EQ.3)THEN
  286.  
  287.       FN( 6,LL)=F1
  288.       FN( 4,LL)=F2
  289.       FN( 5,LL)=F3
  290.       FN(18,LL)=F4
  291.       FN(17,LL)=F5
  292.       FN( 9,LL)=F6
  293.  
  294.       GR(1, 6,LL)=GX1
  295.       GR(1, 4,LL)=GX2
  296.       GR(1, 5,LL)=GX3
  297.       GR(1,18,LL)=GX4
  298.       GR(1,17,LL)=GX5
  299.       GR(1, 9,LL)=GX6
  300.  
  301.       GR(2, 6,LL)=GY1
  302.       GR(2, 4,LL)=GY2
  303.       GR(2, 5,LL)=GY3
  304.       GR(2,18,LL)=GY4
  305.       GR(2,17,LL)=GY5
  306.       GR(2, 9,LL)=GY6
  307.  
  308.       GR(3, 6,LL)=GZ1
  309.       GR(3, 4,LL)=GZ2
  310.       GR(3, 5,LL)=GZ3
  311.       GR(3,18,LL)=GZ4
  312.       GR(3,17,LL)=GZ5
  313.       GR(3, 9,LL)=GZ6
  314.  
  315.       ELSEIF(K.EQ.4)THEN
  316.  
  317.       FN( 4,LL)=F1
  318.       FN( 6,LL)=F2
  319.       FN( 2,LL)=F3
  320.       FN(17,LL)=F4
  321.       FN(18,LL)=F5
  322.       FN(16,LL)=F6
  323.  
  324.       GR(1, 4,LL)=GX1
  325.       GR(1, 6,LL)=GX2
  326.       GR(1, 2,LL)=GX3
  327.       GR(1,17,LL)=GX4
  328.       GR(1,18,LL)=GX5
  329.       GR(1,16,LL)=GX6
  330.  
  331.       GR(2, 4,LL)=GY1
  332.       GR(2, 6,LL)=GY2
  333.       GR(2, 2,LL)=GY3
  334.       GR(2,17,LL)=GY4
  335.       GR(2,18,LL)=GY5
  336.       GR(2,16,LL)=GY6
  337.  
  338.       GR(3, 4,LL)=GZ1
  339.       GR(3, 6,LL)=GZ2
  340.       GR(3, 2,LL)=GZ3
  341.       GR(3,17,LL)=GZ4
  342.       GR(3,18,LL)=GZ5
  343.       GR(3,16,LL)=GZ6
  344.  
  345.       ELSEIF(K.EQ.5)THEN
  346.  
  347.       FN( 7,LL)=F1
  348.       FN(16,LL)=F2
  349.       FN(18,LL)=F3
  350.       FN(10,LL)=F4
  351.       FN(11,LL)=F5
  352.       FN(15,LL)=F6
  353.  
  354.       GR(1, 7,LL)=GX1
  355.       GR(1,16,LL)=GX2
  356.       GR(1,18,LL)=GX3
  357.       GR(1,10,LL)=GX4
  358.       GR(1,11,LL)=GX5
  359.       GR(1,15,LL)=GX6
  360.  
  361.       GR(2, 7,LL)=GY1
  362.       GR(2,16,LL)=GY2
  363.       GR(2,18,LL)=GY3
  364.       GR(2,10,LL)=GY4
  365.       GR(2,11,LL)=GY5
  366.       GR(2,15,LL)=GY6
  367.  
  368.       GR(3, 7,LL)=GZ1
  369.       GR(3,16,LL)=GZ2
  370.       GR(3,18,LL)=GZ3
  371.       GR(3,10,LL)=GZ4
  372.       GR(3,11,LL)=GZ5
  373.       GR(3,15,LL)=GZ6
  374.  
  375.       ELSEIF(K.EQ.6)THEN
  376.  
  377.       FN(16,LL)=F1
  378.       FN( 8,LL)=F2
  379.       FN(17,LL)=F3
  380.       FN(11,LL)=F4
  381.       FN(12,LL)=F5
  382.       FN(13,LL)=F6
  383.  
  384.       GR(1,16,LL)=GX1
  385.       GR(1, 8,LL)=GX2
  386.       GR(1,17,LL)=GX3
  387.       GR(1,11,LL)=GX4
  388.       GR(1,12,LL)=GX5
  389.       GR(1,13,LL)=GX6
  390.  
  391.       GR(2,16,LL)=GY1
  392.       GR(2, 8,LL)=GY2
  393.       GR(2,17,LL)=GY3
  394.       GR(2,11,LL)=GY4
  395.       GR(2,12,LL)=GY5
  396.       GR(2,13,LL)=GY6
  397.  
  398.       GR(3,16,LL)=GZ1
  399.       GR(3, 8,LL)=GZ2
  400.       GR(3,17,LL)=GZ3
  401.       GR(3,11,LL)=GZ4
  402.       GR(3,12,LL)=GZ5
  403.       GR(3,13,LL)=GZ6
  404.  
  405.       ELSEIF(K.EQ.7)THEN
  406.  
  407.       FN(18,LL)=F1
  408.       FN(17,LL)=F2
  409.       FN( 9,LL)=F3
  410.       FN(15,LL)=F4
  411.       FN(13,LL)=F5
  412.       FN(14,LL)=F6
  413.  
  414.       GR(1,18,LL)=GX1
  415.       GR(1,17,LL)=GX2
  416.       GR(1, 9,LL)=GX3
  417.       GR(1,15,LL)=GX4
  418.       GR(1,13,LL)=GX5
  419.       GR(1,14,LL)=GX6
  420.  
  421.       GR(2,18,LL)=GY1
  422.       GR(2,17,LL)=GY2
  423.       GR(2, 9,LL)=GY3
  424.       GR(2,15,LL)=GY4
  425.       GR(2,13,LL)=GY5
  426.       GR(2,14,LL)=GY6
  427.  
  428.       GR(3,18,LL)=GZ1
  429.       GR(3,17,LL)=GZ2
  430.       GR(3, 9,LL)=GZ3
  431.       GR(3,15,LL)=GZ4
  432.       GR(3,13,LL)=GZ5
  433.       GR(3,14,LL)=GZ6
  434.  
  435.       ELSEIF(K.EQ.8)THEN
  436.  
  437.       FN(17,LL)=F1
  438.       FN(18,LL)=F2
  439.       FN(16,LL)=F3
  440.       FN(13,LL)=F4
  441.       FN(15,LL)=F5
  442.       FN(11,LL)=F6
  443.  
  444.       GR(1,17,LL)=GX1
  445.       GR(1,18,LL)=GX2
  446.       GR(1,16,LL)=GX3
  447.       GR(1,13,LL)=GX4
  448.       GR(1,15,LL)=GX5
  449.       GR(1,11,LL)=GX6
  450.  
  451.       GR(2,17,LL)=GY1
  452.       GR(2,18,LL)=GY2
  453.       GR(2,16,LL)=GY3
  454.       GR(2,13,LL)=GY4
  455.       GR(2,15,LL)=GY5
  456.       GR(2,11,LL)=GY6
  457.  
  458.       GR(3,17,LL)=GZ1
  459.       GR(3,18,LL)=GZ2
  460.       GR(3,16,LL)=GZ3
  461.       GR(3,13,LL)=GZ4
  462.       GR(3,15,LL)=GZ5
  463.       GR(3,11,LL)=GZ6
  464.  
  465.       ENDIF
  466.  
  467.  1    CONTINUE
  468.  
  469.       IF(NOM2.EQ.'MCP0')THEN
  470.       DO 2 L=1,NPG
  471.       FM(1,L)=1.D0
  472.       GM(1,1,L)=0.D0
  473.       GM(2,1,L)=0.D0
  474.       GM(3,1,L)=0.D0
  475.  2    CONTINUE
  476.       ELSEIF(NOM2.EQ.'MCP1')THEN
  477.  
  478.       DO 3 LL=1,(2*NGG)
  479.       FM(1,LL)=0.25D0
  480.       FM(2,LL+2*NGG)=0.25D0
  481.       FM(3,LL+4*NGG)=0.25D0
  482.       FM(4,LL+6*NGG)=0.25D0
  483.  3    CONTINUE
  484.       CALL INITD(GM,(12*NPG),0.D0)
  485.       ELSEIF(NOM2.EQ.'MCF1')THEN
  486.       DO 4 L=1,NPG
  487.       FM(1,L)=(X(L)+Y(L)-R2)*(Z(L)-1.D0)/R2
  488.       FM(2,L)=-X(L)*(Z(L)-1.D0)/R2
  489.       FM(3,L)=-Y(L)*(Z(L)-1.D0)/R2
  490.       FM(4,L)=-(X(L)+Y(L)-R2)*Z(L)/R2
  491.       FM(5,L)=X(L)*Z(L)/R2
  492.       FM(6,L)=Y(L)*Z(L)/R2
  493.  
  494.       GM(1,1,L)=(Z(L)-1.D0)/R2
  495.       GM(2,1,L)=(Z(L)-1.D0)/R2
  496.       GM(3,1,L)=(X(L)+Y(L)-R2)/R2
  497.       GM(1,2,L)=-(Z(L)-1.D0)/R2
  498.       GM(2,2,L)=0.D0
  499.       GM(3,2,L)=-X(L)/R2
  500.       GM(1,3,L)=0.D0
  501.       GM(2,3,L)=-(Z(L)-1.D0)/R2
  502.       GM(3,3,L)=-Y(L)/R2
  503.       GM(1,4,L)=-Z(L)/R2
  504.       GM(2,4,L)=-Z(L)/R2
  505.       GM(3,4,L)=-(X(L)+Y(L)-R2)/R2
  506.       GM(1,5,L)=Z(L)/R2
  507.       GM(2,5,L)=0.D0
  508.       GM(3,5,L)=X(L)/R2
  509.       GM(1,6,L)=0.D0
  510.       GM(2,6,L)=Z(L)/R2
  511.       GM(3,6,L)=Y(L)/R2
  512. C
  513.  4    CONTINUE
  514.       ENDIF
  515. C     write(6,*)' FM'
  516. C     write(6,1002)((FM(II,JJ),II=1,MP),JJ=1,NPG)
  517.  
  518. C     write(6,*)' VERIF ,PG='
  519. C     write(6,1002)(pg(ii),ii=1,npg)
  520. C     do 75 ll=1,npg
  521. C     write(6,*)' VERIF ,fn,gr ll=',ll
  522. C     write(6,1002)(fn(ii,ll),ii=1,np)
  523. C     write(6,1002)(gr(1,ii,ll),ii=1,np)
  524. C     write(6,1002)(gr(2,ii,ll),ii=1,np)
  525. C     write(6,1002)(gr(3,ii,ll),ii=1,np)
  526. C75   continue
  527.  
  528. C     write(6,*)' VERIF ,NPG,NP,NGG=',NPG,NP,NGG
  529. C     UPG=0.D0
  530. C     do 72 L=1,NPG
  531. C     UPG=UPG+PG(L)
  532. C     UF=0.D0
  533. C     UG1=0.D0
  534. C     UG2=0.D0
  535. C     UG3=0.D0
  536. C     DO 71 I=1,NP
  537. C     UF=UF+FN(I,L)
  538. C     UG1=UG1+GR(1,I,L)
  539. C     UG2=UG2+GR(2,I,L)
  540. C     UG3=UG3+GR(3,I,L)
  541. C71   CONTINUE
  542. C     WRITE(6,*)' VERIF L=',L,UF,UG1,UG2,UG3
  543. C72   CONTINUE
  544.  
  545. C     WRITE(6,*)' VERIF PG=',UPG
  546. C     WRITE(6,101)
  547.  
  548. C     IF(MP.EQ.1)THEN
  549. C     DO 4 L=1,NPG
  550. C     FM(1,L)=1.D0
  551. C     GM(1,1,L)=0.D0
  552. C     GM(2,1,L)=0.D0
  553. C     GM(3,1,L)=0.D0
  554. C4    CONTINUE
  555. C     ELSEIF(MP.EQ.4)THEN
  556. C     XX(1)=X(L)
  557. C     XX(2)=Y(L)
  558. C     XX(3)=Z(L)
  559. C     FM(1,L)=EQPL3P(XX,XB,XC,XD)/
  560. C    &        EQPL3P(XA,XB,XC,XD)
  561. C     FM(2,L)=EQPL3P(XX,XA,XC,XD)/
  562. C    &        EQPL3P(XB,XA,XC,XD)
  563. C     FM(3,L)=EQPL3P(XX,XA,XB,XD)/
  564. C    &        EQPL3P(XC,XA,XB,XD)
  565. C
  566. C     FM(4,L)=EQPL3P(XX,XA,XB,XC)/
  567. C    &        EQPL3P(XD,XA,XB,XC)
  568. C     CALL INITD(GM,(12*NPG),0.D0)
  569. C3    CONTINUE
  570. C     ENDIF
  571.  
  572. C     WRITE(6,101)
  573.  
  574.       RETURN
  575.  1002 FORMAT(10(1X,1PD11.4))
  576.  1001 FORMAT(20(1X,I5))
  577.  101  FORMAT(1X,'... SUBPB663 ... FM,GM,FN,GR ',9(10H..........)/)
  578. C
  579.       END
  580.  
  581.  
  582.  
  583.  
  584.  
  585.  

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