Télécharger la plaquette Cast3M


fr en

Télécharger pb401.eso

Retour à la liste

Numérotation des lignes : 

pb401

  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