Télécharger la plaquette Cast3M


fr en

Télécharger pb342.eso

Retour à la liste

Numérotation des lignes : 

pb342

  1. C PB342     SOURCE    CHAT      05/01/13    02:10:18     5004
  2.       SUBROUTINE PB342(X,Y,PG,FN,GR,FM,GM,ND,NP,MP,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-P2  P1/P0
  8. C
  9. C     ^ eta
  10. C     |n5
  11. C     |\
  12. C     | \
  13. C     |3x\
  14. C     |   \
  15. C   n6_____\n4
  16. C   a |\   |\
  17. C     | \4 | \               a=sqrt(2)
  18. C     |1x\ |2x\
  19. C     |___\|___\_______________>ksi
  20. C     0   a/2  a
  21. C     n1  n2   n3
  22. C
  23. C
  24. C************************************************************************
  25.  
  26.       REAL*8 X(NPG),Y(NPG)
  27.       DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
  28.       DIMENSION FM(MP,NPG),GM(ND,MP,NPG)
  29.       REAL*8 A,B,C,D,U(5),H(5)
  30.       CHARACTER*4 NOM2
  31. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  32. C     write(6,*)' PB342 NOM2=',NOM2
  33.  
  34.       NP2=NP*ND
  35.       A=SQRT(2.D0)
  36.       R2=SQRT(2.D0)
  37.       A1=6.D0/5.D0/A
  38.       AI=1.D0/A
  39.  
  40.       IF(NPG.NE.7)THEN
  41.       WRITE(6,*)' Sub PB342 NPG ne 7 ?! on ne sait pas faire '
  42.       STOP
  43.       ENDIF
  44.  
  45. C     write(6,*)' MP,NPG=',mp,npg
  46.  
  47.       CALL CALUHH(X,Y,PG,NPG)
  48.       DO 1 L=1,4
  49. C     write(6,*)' X,Y,L=',X(L),Y(L),L
  50. C
  51.       FN(1,L)=0.D0
  52.       GR(1,1,L)=0.D0
  53.       GR(2,1,L)=0.D0
  54.  
  55.       FN(2,L)=(A-2.D0*Y(L))/A
  56.       GR(1,2,L)=0.D0
  57.       GR(2,2,L)=-2.D0/A
  58.  
  59.       FN(3,L)=0.D0
  60.       GR(1,3,L)=0.D0
  61.       GR(2,3,L)=0.D0
  62.  
  63.       FN(4,L)=(2.D0*X(L)+2.D0*Y(L)-A)/A
  64.       GR(1,4,L)=2.D0/A
  65.       GR(2,4,L)=2.D0/A
  66.  
  67.       FN(5,L)=0.D0
  68.       GR(1,5,L)=0.D0
  69.       GR(2,5,L)=0.D0
  70.  
  71.       FN(6,L)=-(2.D0*X(L)-A)/A
  72.       GR(1,6,L)=-2.D0/A
  73.       GR(2,6,L)=0.D0
  74.  
  75.       IF(NOM2.EQ.'MCP0')THEN
  76.       FM(1,L)=1.D0
  77.       GM(1,1,L)=0.D0
  78.       GM(2,1,L)=0.D0
  79.       ELSEIF(NOM2.EQ.'MCP1')THEN
  80.       FM(1,L)=5.D0/3.D0*(1.D0-(A1*X(L))-(A1*Y(L)))
  81.       FM(2,L)=-1.D0/3.D0*(1.D0-(6.D0*X(L)/A))
  82.       FM(3,L)=-1.D0/3.D0*(1.D0-(6.D0*Y(L)/A))
  83.       GM(1,1,L)=0.D0
  84.       GM(2,1,L)=0.D0
  85.       GM(1,2,L)=0.D0
  86.       GM(2,2,L)=0.D0
  87.       GM(1,3,L)=0.D0
  88.       GM(2,3,L)=0.D0
  89.       ELSEIF(NOM2.EQ.'MCF1')THEN
  90.       FM(1,L)=-AI*(X(L)+Y(L)-A)
  91.       FM(2,L)=AI*X(L)
  92.       FM(3,L)=AI*Y(L)
  93.  
  94.       GM(1,1,L)=-R2/2.D0
  95.       GM(2,1,L)=-R2/2.D0
  96.       GM(1,2,L)=R2/2.D0
  97.       GM(2,2,L)=0.D0
  98.       GM(1,3,L)=0.D0
  99.       GM(2,3,L)=R2/2.D0
  100.       ENDIF
  101.  
  102. C
  103.  1    CONTINUE
  104.  
  105. C**** L=5 ****
  106.       L=5
  107. C     write(6,*)' X,Y,L=',X(L),Y(L),L
  108.  
  109.       FN(1,L)=-(2.D0*X(L)+2.D0*Y(L)-A)/A
  110.       GR(1,1,L)=-2.D0/A
  111.       GR(2,1,L)=-2.D0/A
  112.  
  113.       FN(2,L)=2.D0*X(L)/A
  114.       GR(1,2,L)=2.D0/A
  115.       GR(2,2,L)=0.D0
  116.  
  117.       FN(3,L)=0.D0
  118.       GR(1,3,L)=0.D0
  119.       GR(2,3,L)=0.D0
  120.  
  121.       FN(4,L)=0.D0
  122.       GR(1,4,L)=0.D0
  123.       GR(2,4,L)=0.D0
  124.  
  125.       FN(5,L)=0.D0
  126.       GR(1,5,L)=0.D0
  127.       GR(2,5,L)=0.D0
  128.  
  129.       FN(6,L)=2.D0*Y(L)/A
  130.       GR(1,6,L)=0.D0
  131.       GR(2,6,L)=2.D0/A
  132.  
  133.       IF(NOM2.EQ.'MCP0')THEN
  134.       FM(1,L)=1.D0
  135.       GM(1,1,L)=0.D0
  136.       GM(2,1,L)=0.D0
  137.       ELSEIF(NOM2.EQ.'MCP1')THEN
  138.       FM(1,L)=5.D0/3.D0*(1.D0-(A1*X(L))-(A1*Y(L)))
  139.       FM(2,L)=-1.D0/3.D0*(1.D0-(6.D0*X(L)/A))
  140.       FM(3,L)=-1.D0/3.D0*(1.D0-(6.D0*Y(L)/A))
  141.       GM(1,1,L)=0.D0
  142.       GM(2,1,L)=0.D0
  143.       GM(1,2,L)=0.D0
  144.       GM(2,2,L)=0.D0
  145.       GM(1,3,L)=0.D0
  146.       GM(2,3,L)=0.D0
  147.       ELSEIF(NOM2.EQ.'MCF1')THEN
  148.       FM(1,L)=-AI*(X(L)+Y(L)-A)
  149.       FM(2,L)=AI*X(L)
  150.       FM(3,L)=AI*Y(L)
  151.  
  152.       GM(1,1,L)=-R2/2.D0
  153.       GM(2,1,L)=-R2/2.D0
  154.       GM(1,2,L)=R2/2.D0
  155.       GM(2,2,L)=0.D0
  156.       GM(1,3,L)=0.D0
  157.       GM(2,3,L)=R2/2.D0
  158.       ENDIF
  159.  
  160.  
  161. C**** L=6 ****
  162.       L=6
  163. C     write(6,*)' X,Y,L=',X(L),Y(L),L
  164.  
  165.       FN(1,L)=0.D0
  166.       GR(1,1,L)=0.D0
  167.       GR(2,1,L)=0.D0
  168.  
  169.       FN(2,L)=-2.D0*(X(L)+Y(L)-A)/A
  170.       GR(1,2,L)=-2.D0/A
  171.       GR(2,2,L)=-2.D0/A
  172.  
  173.       FN(3,L)=(2.D0*X(L)-A)/A
  174.       GR(1,3,L)=2.D0/A
  175.       GR(2,3,L)=0.D0
  176.  
  177.       FN(4,L)=2.D0*Y(L)/A
  178.       GR(1,4,L)=0.D0
  179.       GR(2,4,L)=2.D0/A
  180.  
  181.       FN(5,L)=0.D0
  182.       GR(1,5,L)=0.D0
  183.       GR(2,5,L)=0.D0
  184.  
  185.       FN(6,L)=0.D0
  186.       GR(1,6,L)=0.D0
  187.       GR(2,6,L)=0.D0
  188.  
  189.       IF(NOM2.EQ.'MCP0')THEN
  190.       FM(1,L)=1.D0
  191.       GM(1,1,L)=0.D0
  192.       GM(2,1,L)=0.D0
  193.       ELSEIF(NOM2.EQ.'MCP1')THEN
  194.       FM(1,L)=5.D0/3.D0*(1.D0-(A1*X(L))-(A1*Y(L)))
  195.       FM(2,L)=-1.D0/3.D0*(1.D0-(6.D0*X(L)/A))
  196.       FM(3,L)=-1.D0/3.D0*(1.D0-(6.D0*Y(L)/A))
  197.       GM(1,1,L)=0.D0
  198.       GM(2,1,L)=0.D0
  199.       GM(1,2,L)=0.D0
  200.       GM(2,2,L)=0.D0
  201.       GM(1,3,L)=0.D0
  202.       GM(2,3,L)=0.D0
  203.       ELSEIF(NOM2.EQ.'MCF1')THEN
  204.       FM(1,L)=-AI*(X(L)+Y(L)-A)
  205.       FM(2,L)=AI*X(L)
  206.       FM(3,L)=AI*Y(L)
  207.  
  208.       GM(1,1,L)=-R2/2.D0
  209.       GM(2,1,L)=-R2/2.D0
  210.       GM(1,2,L)=R2/2.D0
  211.       GM(2,2,L)=0.D0
  212.       GM(1,3,L)=0.D0
  213.       GM(2,3,L)=R2/2.D0
  214.       ENDIF
  215.  
  216.  
  217. C**** L=7 ****
  218.       L=7
  219. C     write(6,*)' X,Y,L=',X(L),Y(L),L
  220.  
  221.       FN(1,L)=0.D0
  222.       GR(1,1,L)=0.D0
  223.       GR(2,1,L)=0.D0
  224.  
  225.       FN(2,L)=0.D0
  226.       GR(1,2,L)=0.D0
  227.       GR(2,2,L)=0.D0
  228.  
  229.       FN(3,L)=0.D0
  230.       GR(1,3,L)=0.D0
  231.       GR(2,3,L)=0.D0
  232.  
  233.       FN(4,L)=2.D0*X(L)/A
  234.       GR(1,4,L)=2.D0/A
  235.       GR(2,4,L)=0.D0
  236.  
  237.       FN(5,L)=(2.D0*Y(L)-A)/A
  238.       GR(1,5,L)=0.D0
  239.       GR(2,5,L)=2.D0/A
  240.  
  241.       FN(6,L)=-2.D0*(X(L)+Y(L)-A)/A
  242.       GR(1,6,L)=-2.D0/A
  243.       GR(2,6,L)=-2.D0/A
  244.  
  245.       IF(NOM2.EQ.'MCP0')THEN
  246.       FM(1,L)=1.D0
  247.       GM(1,1,L)=0.D0
  248.       GM(2,1,L)=0.D0
  249.       ELSEIF(NOM2.EQ.'MCP1')THEN
  250.       FM(1,L)=5.D0/3.D0*(1.D0-(A1*X(L))-(A1*Y(L)))
  251.       FM(2,L)=-1.D0/3.D0*(1.D0-(6.D0*X(L)/A))
  252.       FM(3,L)=-1.D0/3.D0*(1.D0-(6.D0*Y(L)/A))
  253.       GM(1,1,L)=0.D0
  254.       GM(2,1,L)=0.D0
  255.       GM(1,2,L)=0.D0
  256.       GM(2,2,L)=0.D0
  257.       GM(1,3,L)=0.D0
  258.       GM(2,3,L)=0.D0
  259.       ELSEIF(NOM2.EQ.'MCF1')THEN
  260.       FM(1,L)=-AI*(X(L)+Y(L)-A)
  261.       FM(2,L)=AI*X(L)
  262.       FM(3,L)=AI*Y(L)
  263.  
  264.       GM(1,1,L)=-R2/2.D0
  265.       GM(2,1,L)=-R2/2.D0
  266.       GM(1,2,L)=R2/2.D0
  267.       GM(2,2,L)=0.D0
  268.       GM(1,3,L)=0.D0
  269.       GM(2,3,L)=R2/2.D0
  270.       ENDIF
  271.  
  272.  
  273. C     WRITE(6,101)
  274. C     WRITE(6,1002)FM
  275. C     WRITE(6,1002)GM
  276. C     WRITE(6,1002)FN
  277. C     WRITE(6,1002)GR
  278. C     WRITE(6,101)
  279.       RETURN
  280.  1002 FORMAT(10(1X,1PD11.4))
  281.  1001 FORMAT(20(1X,I5))
  282.  101  FORMAT(1X,'... SUBPB302 ... FM,GM,FN,GR ',9(10H..........)/)
  283. C
  284.       END
  285.  
  286.  
  287.  
  288.  
  289.  
  290.  
  291.  

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