Télécharger pb401.eso

Retour à la liste

Numérotation des lignes :

  1. C PB401 SOURCE CHAT 05/01/13 02:10:21 5004
  2. SUBROUTINE PB401(X,PG,FN,GR,FM,GM,ND,NP,MP,NG,NPG,MPG)
  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 : SEG4
  8. C
  9. C************************************************************************
  10.  
  11. DIMENSION X(NPG)
  12. DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
  13. REAL*8 FM(MP,MPG),GM(ND,MP,MPG)
  14. DIMENSION U(5),H(5)
  15.  
  16. CALL CALUHG(U,H,NG)
  17. A=0.D0
  18. B=1.D0
  19. CALL CALG1(A,B,NG,H,U,X,PG)
  20. DO 1 L=1,NPG
  21. C
  22. FN(1,L)=(1.D0-3.D0*X(L))*(2.D0-3.D0*X(L))*(1.D0-X(L))/2.D0
  23. FN(2,L)=X(L)*(2.D0-3.D0*X(L))*(1.D0-X(L))/2.D0
  24. FN(3,L)=-X(L)*(1.D0-3.D0*X(L))*(1.D0-X(L))/2.D0
  25. FN(4,L)=X(L)*(1.D0-3.D0*X(L))*(2.D0-3.D0*X(L))/2.D0
  26. GR(1,1,L)=-(1.D0-3.D0*X(L))*(2.D0-3.D0*X(L))/2.D0
  27. & -3.D0*(1.D0-3.D0*X(L))*(1.D0-X(L))/2.D0
  28. & -3.D0*(2.D0-3.D0*X(L))*(1.D0-X(L))/2.D0
  29. GR(1,2,L)=-X(L)*(2.D0-3.D0*X(L))/2.D0
  30. & -3.D0*X(L)*(1.D0-X(L))/2.D0
  31. & +(2.D0-3.D0*X(L))*(1.D0-X(L))/2.D0
  32. GR(1,3,L)=-X(L)*(1.D0-3.D0*X(L))/2.D0
  33. & +3.D0*X(L)*(1.D0-X(L))/2.D0
  34. & -(1.D0-3.D0*X(L))*(1.D0-X(L))/2.D0
  35. GR(1,4,L)=-3.D0*X(L)*(1.D0-3.D0*X(L))/2.D0
  36. & -3.D0*X(L)*(2.D0-3.D0*X(L))/2.D0
  37. & +(1.D0-3.D0*X(L))*(2.D0-3.D0*X(L))/2.D0
  38. 1 CONTINUE
  39.  
  40. IF(MP.EQ.1)THEN
  41. DO 2 L=1,MPG
  42. FM(1,L)=1.D0
  43. GM(1,1,L)=0.D0
  44. 2 CONTINUE
  45. ELSEIF(MP.EQ.3)THEN
  46. DO 3 L=1,MPG
  47. FM(1,L)= (X(L)-1.D0)*(2.D0*X(L)-1.D0)
  48. FM(2,L)=-4.D0*X(L)*(X(L)-1.D0)
  49. FM(3,L)=X(L)*(2.D0*X(L)-1.D0)
  50. 3 CONTINUE
  51. CALL INITD(GM,(ND*MP*MPG),0.D0)
  52.  
  53. ENDIF
  54.  
  55. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  56. C WRITE(6,101)
  57. C WRITE(6,1002)FN
  58. C WRITE(6,1002)GR
  59. C WRITE(6,101)
  60. RETURN
  61. 1002 FORMAT(10(1X,1PD11.4))
  62. 1001 FORMAT(20(1X,I5))
  63. 101 FORMAT(1X,'... SUB PB401 ... FN,GR ',9(10H..........)/)
  64. C
  65. END
  66.  
  67.  
  68.  
  69.  
  70.  

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