Télécharger la plaquette Cast3M


fr en

Télécharger pb402.eso

Retour à la liste

Numérotation des lignes : 

pb402

  1. C PB402     SOURCE    MAGN      10/05/18    21:16:34     6675
  2.       SUBROUTINE PB402
  3.      &(XREF,X,Y,PG,FN,GR,FM,GM,ND,NP,MP,NG,NPG,NOM2,ITYPI)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6. C************************************************************************
  7. C
  8. C     CALCULE LES FONCTIONS DE FORME D'UN : QUA4
  9. C
  10. C     ^ eta
  11. C     |
  12. C   1 |________
  13. C     |n4     |n3
  14. C     |       |
  15. C     |       |
  16. C     |_______|_____>ksi
  17. C     0       1
  18. C     n1      n2
  19. C************************************************************************
  20.  
  21.       REAL*8 X(NPG),Y(NPG),XREF(ND,NP)
  22.       REAL*8 FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
  23.       REAL*8 FM(MP,NPG),GM(ND,MP,NPG)
  24.       REAL*8 A,B,C,D,U(6),H(6)
  25.       CHARACTER*4 NOM2
  26. C***
  27.       XREF(1,1)=0.D0
  28.       XREF(2,1)=0.D0
  29.       XREF(1,2)=1.D0
  30.       XREF(2,2)=0.D0
  31.       XREF(1,3)=1.D0
  32.       XREF(2,3)=1.D0
  33.       XREF(1,4)=0.D0
  34.       XREF(2,4)=1.D0
  35.  
  36. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  37.       NGG=NG*NG
  38.       IF(NP.NE.4.OR.ND.NE.2.OR.NGG.NE.NPG)
  39.      *WRITE(6,1001)NP,ND,NG,NPG,NGG
  40.       IF(NP.NE.4.OR.ND.NE.2.OR.NGG.NE.NPG)CALL ARRET(0)
  41.       NP2=NP*ND
  42. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  43.       CALL CALUHG(U,H,NG)
  44.       A=0.D0
  45.       B=1.D0
  46.       C=0.D0
  47.       D=1.D0
  48.       IF(ITYPI.EQ.2)THEN
  49.       X(1)=0.D0
  50.       Y(1)=0.D0
  51.       X(2)=1.D0
  52.       Y(2)=0.D0
  53.       X(3)=1.D0
  54.       Y(3)=1.D0
  55.       X(4)=0.D0
  56.       Y(4)=1.D0
  57.       DO 2 L=1,4
  58.       PG(L)=1.D0/4.D0
  59.  2    CONTINUE
  60.       ELSE
  61.       CALL CALG2(A,B,C,D,NG,H,U,X,Y,PG)
  62.       ENDIF
  63.       DO 1 L=1,NPG
  64. C
  65.       FN(1,L)=(X(L)-1.D0)*(Y(L)-1.D0)
  66.       FN(2,L)=-X(L)*(Y(L)-1.D0)
  67.       FN(3,L)=X(L)*Y(L)
  68.       FN(4,L)=-Y(L)*(X(L)-1.D0)
  69. C
  70.       GR(1,1,L)=Y(L)-1.D0
  71.       GR(2,1,L)=X(L)-1.D0
  72.       GR(1,2,L)=-(Y(L)-1.D0)
  73.       GR(2,2,L)=-X(L)
  74.       GR(1,3,L)=Y(L)
  75.       GR(2,3,L)=X(L)
  76.       GR(1,4,L)=-Y(L)
  77.       GR(2,4,L)=-(X(L)-1.D0)
  78. C
  79.  
  80.       IF(NOM2.EQ.'P1P1')THEN
  81.       FM(1,L)=FN(1,L)
  82.       FM(2,L)=FN(2,L)
  83.       FM(3,L)=FN(3,L)
  84.       FM(4,L)=FN(4,L)
  85.       GM(1,1,L)=Y(L)-1.D0
  86.       GM(2,1,L)=X(L)-1.D0
  87.       GM(1,2,L)=-(Y(L)-1.D0)
  88.       GM(2,2,L)=-X(L)
  89.       GM(1,3,L)=Y(L)
  90.       GM(2,3,L)=X(L)
  91.       GM(1,4,L)=-Y(L)
  92.       GM(2,4,L)=-(X(L)-1.D0)
  93.       ELSE
  94.       FM(1,L)=1.D0
  95.       GM(1,1,L)=0.D0
  96.       GM(2,1,L)=0.D0
  97.       ENDIF
  98.  
  99.  1    CONTINUE
  100.  
  101. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  102. C     WRITE(6,101)
  103. C     WRITE(6,1002)FN
  104. C     WRITE(6,1002)GR
  105. C     WRITE(6,101)
  106.       RETURN
  107.  1002 FORMAT(10(1X,1PE11.4))
  108.  1001 FORMAT(20(1X,I5))
  109.  101  FORMAT(1X,'... SUB PB402 ... FN,GR,FX,GX ',9(10H..........)/)
  110. C
  111.       END
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  

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