Télécharger pb603.eso

Retour à la liste

Numérotation des lignes :

  1. C PB603 SOURCE MAGN 10/05/19 21:15:12 6676
  2. SUBROUTINE PB603(XREF,X,Y,Z,PG,FN,GR,FM,GM,ND,NP,MP,NPG,NOM2)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C************************************************************************
  6. C
  7. C
  8. C
  9. C************************************************************************
  10.  
  11. REAL*8 XREF(ND,NP),X(NPG),Y(NPG),Z(NPG)
  12. CHARACTER*4 NOM2
  13. DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
  14. DIMENSION FM(MP,NPG),GM(ND,MP,NPG)
  15. * TC n'a pas l'air de servir
  16. * DIMENSION U(5),H(5),XA(3),XB(3),XC(3),XD(3),XX(3)
  17. ** SAVE XA,XB,XC,XD
  18. * DATA XA/3*0.25D0/,XB/0.75D0,0.25D0,0.75D0/
  19. * DATA XC/2*0.75D0,0.25D0/,XD/0.25D0,2*0.75D0/
  20. C***
  21. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  22. R2=SQRT(2.D0)
  23. NP2=NP*ND
  24.  
  25. XREF(1,1)=0.D0
  26. XREF(2,1)=0.D0
  27. XREF(3,1)=0.D0
  28. XREF(1,2)=R2
  29. XREF(2,2)=0.D0
  30. XREF(3,2)=0.D0
  31. XREF(1,3)=0.D0
  32. XREF(2,3)=R2
  33. XREF(3,3)=0.D0
  34.  
  35. XREF(1,4)=0.D0
  36. XREF(2,4)=0.D0
  37. XREF(3,4)=1.D0
  38. XREF(1,5)=R2
  39. XREF(2,5)=0.D0
  40. XREF(3,5)=1.D0
  41. XREF(1,6)=0.D0
  42. XREF(2,6)=R2
  43. XREF(3,6)=1.D0
  44.  
  45. C Verification des coordonnées
  46. C IF(.TRUE.)THEN
  47. IF(.FALSE.)THEN
  48. DO 11 L=1,NP
  49. X(L)=XREF(1,L)
  50. Y(L)=XREF(2,L)
  51. Z(L)=XREF(3,L)
  52. 11 CONTINUE
  53.  
  54. DO 12 L=1,NP
  55. FN(1,L)=(X(L)+Y(L)-R2)*(Z(L)-1.D0)/R2
  56. FN(2,L)=-X(L)*(Z(L)-1.D0)/R2
  57. FN(3,L)=-Y(L)*(Z(L)-1.D0)/R2
  58. FN(4,L)=-(X(L)+Y(L)-R2)*Z(L)/R2
  59. FN(5,L)=X(L)*Z(L)/R2
  60. FN(6,L)=Y(L)*Z(L)/R2
  61. write(6,1033)L,FN(1,L),FN(2,L),FN(3,L),FN(4,L),FN(5,L),FN(6,L)
  62. 12 CONTINUE
  63. 1033 FORMAT(1X,I4,' FN',10(1X,1PD11.4))
  64. ENDIF
  65. C Fin Vérification
  66.  
  67.  
  68.  
  69.  
  70. CALL CALHPR(X,Y,Z,PG,NPG)
  71.  
  72. DO 1 L=1,NPG
  73. C
  74. FN(1,L)=(X(L)+Y(L)-R2)*(Z(L)-1.D0)/R2
  75. FN(2,L)=-X(L)*(Z(L)-1.D0)/R2
  76. FN(3,L)=-Y(L)*(Z(L)-1.D0)/R2
  77. FN(4,L)=-(X(L)+Y(L)-R2)*Z(L)/R2
  78. FN(5,L)=X(L)*Z(L)/R2
  79. FN(6,L)=Y(L)*Z(L)/R2
  80. C
  81. GR(1,1,L)=(Z(L)-1.D0)/R2
  82. GR(2,1,L)=(Z(L)-1.D0)/R2
  83. GR(3,1,L)=(X(L)+Y(L)-R2)/R2
  84. GR(1,2,L)=-(Z(L)-1.D0)/R2
  85. GR(2,2,L)=0.D0
  86. GR(3,2,L)=-X(L)/R2
  87. GR(1,3,L)=0.D0
  88. GR(2,3,L)=-(Z(L)-1.D0)/R2
  89. GR(3,3,L)=-Y(L)/R2
  90. GR(1,4,L)=-Z(L)/R2
  91. GR(2,4,L)=-Z(L)/R2
  92. GR(3,4,L)=-(X(L)+Y(L)-R2)/R2
  93. GR(1,5,L)=Z(L)/R2
  94. GR(2,5,L)=0.D0
  95. GR(3,5,L)=X(L)/R2
  96. GR(1,6,L)=0.D0
  97. GR(2,6,L)=Z(L)/R2
  98. GR(3,6,L)=Y(L)/R2
  99. C
  100.  
  101. IF(NOM2.EQ.'P1P1')THEN
  102. FM(1,L)=FN(1,L)
  103. FM(2,L)=FN(2,L)
  104. FM(3,L)=FN(3,L)
  105. FM(4,L)=FN(4,L)
  106. FM(5,L)=FN(5,L)
  107. FM(6,L)=FN(6,L)
  108. C
  109. GM(1,1,L)=(Z(L)-1.D0)/R2
  110. GM(2,1,L)=(Z(L)-1.D0)/R2
  111. GM(3,1,L)=(X(L)+Y(L)-R2)/R2
  112. GM(1,2,L)=-(Z(L)-1.D0)/R2
  113. GM(2,2,L)=0.D0
  114. GM(3,2,L)=-X(L)/R2
  115. GM(1,3,L)=0.D0
  116. GM(2,3,L)=-(Z(L)-1.D0)/R2
  117. GM(3,3,L)=-Y(L)/R2
  118. GM(1,4,L)=-Z(L)/R2
  119. GM(2,4,L)=-Z(L)/R2
  120. GM(3,4,L)=-(X(L)+Y(L)-R2)/R2
  121. GM(1,5,L)=Z(L)/R2
  122. GM(2,5,L)=0.D0
  123. GM(3,5,L)=X(L)/R2
  124. GM(1,6,L)=0.D0
  125. GM(2,6,L)=Z(L)/R2
  126. GM(3,6,L)=Y(L)/R2
  127. C
  128. ELSE
  129. FM(1,L)=1.D0
  130. GM(1,1,L)=0.D0
  131. GM(2,1,L)=0.D0
  132. GM(3,1,L)=0.D0
  133. ENDIF
  134.  
  135. 1 CONTINUE
  136. C WRITE(6,101)
  137.  
  138. C WRITE(6,1002)FM
  139. C WRITE(6,1002)GM
  140. C WRITE(6,1002)FN
  141. C WRITE(6,1002)GR
  142. C WRITE(6,101)
  143.  
  144. RETURN
  145. 1002 FORMAT(10(1X,1PD11.4))
  146. 1001 FORMAT(20(1X,I5))
  147. 101 FORMAT(1X,'... SUBPB603 ... FM,GM,FN,GR ',9(10H..........)/)
  148. C
  149. END
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  

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