Télécharger pb402.eso

Retour à la liste

Numérotation des lignes :

  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