Télécharger la plaquette Cast3M


fr en

Télécharger bb403.eso

Retour à la liste

Numérotation des lignes : 

bb403

  1. C BB403     SOURCE    CHAT      05/01/12    21:35:58     5004
  2.       SUBROUTINE BB403(X,Y,Z,PG,FN,GR,FM,GM,ND,NP,MP,NPG)
  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 : TET5 (TET4 + Bulle)
  8. C
  9. C***********************************************************************
  10.       REAL*8 X(NPG),Y(NPG),Z(NPG)
  11.       DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
  12.       DIMENSION FM(MP,NPG),GM(ND,MP,NPG)
  13. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  14.       CO=6.D0 ** (1.D0/3.D0)
  15.       ALFA=(4.D0/CO)**4.D0
  16. C
  17.       IF(NPG.EQ.1)THEN
  18.          XXXX=0.25D0*CO
  19. C
  20.          X(1)=XXXX
  21.          Y(1)=XXXX
  22.          Z(1)=XXXX
  23.          PG(1)=1.D0
  24.       ENDIF
  25.       IF(NPG.EQ.4)THEN
  26.          AL=.5854101966249684D0*CO
  27.          BE=.1381966011250105D0*CO
  28. C
  29.          X(1)=BE
  30.          Y(1)=BE
  31.          Z(1)=BE
  32.          PG(1)=0.25D0
  33. C
  34.          X(2)=AL
  35.          Y(2)=BE
  36.          Z(2)=BE
  37.          PG(2)=0.25D0
  38. C
  39.          X(3)=BE
  40.          Y(3)=AL
  41.          Z(3)=BE
  42.          PG(3)=0.25D0
  43. C
  44.          X(4)=BE
  45.          Y(4)=BE
  46.          Z(4)=AL
  47.          PG(4)=0.25D0
  48. C
  49.       ENDIF
  50. C
  51.       UNSCO=1.D0/CO
  52.       XXXX=-CO
  53.       DO 1 L=1,NPG
  54.       BB=(CO-X(L)-Y(L)-Z(L))*X(L)*Y(L)*Z(L)*ALFA
  55.       BX=ALFA*(Y(L)*Z(L)*(CO-X(L)-Y(L)-Z(L))-(X(L)*Y(L)*Z(L)))
  56.       BY=ALFA*(X(L)*Z(L)*(CO-X(L)-Y(L)-Z(L))-(X(L)*Y(L)*Z(L)))
  57.       BZ=ALFA*(X(L)*Y(L)*(CO-X(L)-Y(L)-Z(L))-(X(L)*Y(L)*Z(L)))
  58. C
  59.          FM(1,L)=1.D0-(X(L)+Y(L)+Z(L))*UNSCO
  60.          FM(2,L)=X(L)*UNSCO
  61.          FM(3,L)=Y(L)*UNSCO
  62.          FM(4,L)=Z(L)*UNSCO
  63. C
  64.          FN(1,L)=FM(1,L)*(1.D0-BB)
  65.          FN(2,L)=FM(2,L)*(1.D0-BB)
  66.          FN(3,L)=FM(3,L)*(1.D0-BB)
  67.          FN(4,L)=FM(4,L)*(1.D0-BB)
  68.          FN(5,L)=BB
  69. C
  70.          GR(1,1,L)=-UNSCO*(1.D0-BB)-BX*FM(1,L)
  71.          GR(2,1,L)=-UNSCO*(1.D0-BB)-BY*FM(1,L)
  72.          GR(3,1,L)=-UNSCO*(1.D0-BB)-BZ*FM(1,L)
  73. C
  74.          GR(1,2,L)=UNSCO*(1.D0-BB)-BX*FM(2,L)
  75.          GR(2,2,L)=-BY*FM(2,L)
  76.          GR(3,2,L)=-BZ*FM(2,L)
  77. C
  78.          GR(1,3,L)=-BX*FM(3,L)
  79.          GR(2,3,L)=UNSCO*(1.D0-BB)-BY*FM(3,L)
  80.          GR(3,3,L)=-BZ*FM(3,L)
  81. C
  82.          GR(1,4,L)=-BX*FM(4,L)
  83.          GR(2,4,L)=-BY*FM(4,L)
  84.          GR(3,4,L)=UNSCO*(1.D0-BB)-BZ*FM(4,L)
  85. C
  86.          GR(1,5,L)=BX
  87.          GR(2,5,L)=BY
  88.          GR(3,5,L)=BZ
  89. C
  90.          GM(1,1,L)=-UNSCO
  91.          GM(2,1,L)=-UNSCO
  92.          GM(3,1,L)=-UNSCO
  93. C
  94.          GM(1,2,L)=UNSCO
  95.          GM(2,2,L)=0.D0
  96.          GM(3,2,L)=0.D0
  97. C
  98.          GM(1,3,L)=0.D0
  99.          GM(2,3,L)=UNSCO
  100.          GM(3,3,L)=0.D0
  101. C
  102.          GM(1,4,L)=0.D0
  103.          GM(2,4,L)=0.D0
  104.          GM(3,4,L)=UNSCO
  105. C
  106.  
  107.  1    CONTINUE
  108.  
  109. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  110. C     WRITE(6,100)
  111. C     WRITE(6,101)
  112. C     WRITE(6,1002)FN
  113. C     WRITE(6,1002)GR
  114. C     WRITE(6,101)
  115.       RETURN
  116.  1002 FORMAT(10(1X,1PD11.4))
  117.  1001 FORMAT(20(1X,I5))
  118.  100  FORMAT(1H1)
  119.  101  FORMAT(1X,'... SUB PB403 ... FN,GR,FOM,GM ',9(10H..........)/)
  120.       END
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  

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