Télécharger ffq.eso

Retour à la liste

Numérotation des lignes :

  1. C FFQ SOURCE CHAT 05/01/12 23:59:09 5004
  2. SUBROUTINE FFQ(NOMS,XA,COOR,XG,IDIM,NP)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C************************************************************************
  6. C
  7. C
  8. C
  9. C************************************************************************
  10. DIMENSION FN(20),XA(3,27),COOR(3,NP),XG(3,NP)
  11. PARAMETER (NBE=18)
  12. CHARACTER*8 NOMS,LISTE(NBE)
  13. DATA LISTE/'SEG3 ','TRI6 ','QUA8 ','TRI7 ','QUA9 ',
  14. &'CU27 ','PR21 ','TE15 ','PY19 ',
  15. &'PR18 ','PY14 ',
  16. &'SEG4 ','TR12 ','QU16 ','CU64 ','PR48 ','TE32 ',
  17. &'PY57 '/
  18. C
  19. R2=SQRT(2.D0)
  20.  
  21. CALL OPTLI(IP,LISTE,NOMS,NBE)
  22. C write(6,*)' FFQ : IP=',ip,' NOMS=',noms,np
  23. IF(IP.EQ.0)RETURN
  24. GO TO (301,602,802,602,802,2703,2103,1503),IP
  25.  
  26. 301 CONTINUE
  27.  
  28. C SEG3
  29. DO 311 L=1,NP
  30. X=COOR(1,L)
  31. Y=COOR(2,L)
  32.  
  33. C
  34. FN(1)=(X-0.5D0)*(X-1.D0)
  35. FN(2)=-2.D0*X*(X+Y-R2)
  36. FN(3)= X*(X-R2/2.D0)
  37. C
  38. DO 321 N=1,IDIM
  39. XG(N,L)=0.D0
  40. DO 331 I=1,3
  41. XG(N,L)=XG(N,L)+FN(I)*XA(N,I)
  42. 331 CONTINUE
  43. 321 CONTINUE
  44. 311 CONTINUE
  45.  
  46. RETURN
  47.  
  48.  
  49.  
  50. 602 CONTINUE
  51. C TRI6
  52. DO 612 L=1,NP
  53. X=COOR(1,L)
  54. Y=COOR(2,L)
  55.  
  56. C
  57. FN(1)=(X+Y-R2/2.D0)*(X+Y-R2)
  58. FN(2)=-2.D0*X*(X+Y-R2)
  59. FN(3)= X*(X-R2/2.D0)
  60. FN(4)=2.D0*X*Y
  61. FN(5)= Y*(Y-R2/2.D0)
  62. FN(6)=-2.D0*Y*(X+Y-R2)
  63. C
  64. DO 622 N=1,IDIM
  65. XG(N,L)=0.D0
  66. DO 632 I=1,6
  67. XG(N,L)=XG(N,L)+FN(I)*XA(N,I)
  68. 632 CONTINUE
  69. 622 CONTINUE
  70. 612 CONTINUE
  71.  
  72. RETURN
  73.  
  74.  
  75.  
  76. 802 CONTINUE
  77. C QUA8
  78. DO 812 L=1,NP
  79. X=COOR(1,L)
  80. Y=COOR(2,L)
  81. C
  82. FN(1)=-2.D0*(1.D0-X)*(1.D0-Y)*(X+Y-0.5D0)
  83. FN(2)= 4.D0*X*(1.D0-X)*(1.D0-Y)
  84. FN(3)=-2.D0*X*(1.D0-Y)*(Y-X+0.5D0)
  85. FN(4)= 4.D0*X*Y*(1.D0-Y)
  86. FN(5)= 2.D0*X*Y*(X+Y-1.5D0)
  87. FN(6)= 4.D0*X*Y*(1.D0-X)
  88. FN(7)= 2.D0*Y*(1.D0-X)*(Y-X-0.5D0)
  89. FN(8)= 4.D0*Y*(1.D0-X)*(1.D0-Y)
  90. C
  91. DO 822 N=1,IDIM
  92. XG(N,L)=0.D0
  93. DO 832 I=1,8
  94. XG(N,L)=XG(N,L)+FN(I)*XA(N,I)
  95. 832 CONTINUE
  96. 822 CONTINUE
  97. 812 CONTINUE
  98. RETURN
  99.  
  100. 2703 CONTINUE
  101. C CU27 -> On ne prend que les 20 premiers points correspondant au CU20
  102. DO 2712 L=1,NP
  103. X=COOR(1,L)
  104. Y=COOR(2,L)
  105. Z=COOR(3,L)
  106. C
  107. FN(1)=-2.D0*(1.D0-X)*(1.D0-Y)*(1.D0-Z)*(X+Y+Z-0.5D0)
  108. FN(2)= 4.D0*X*(1.D0-X)*(1.D0-Y)*(1.D0-Z)
  109. FN(3)=-2.D0*X*(1.D0-Y)*(1.D0-Z)*(Y-X+Z+0.5D0)
  110. FN(4)= 4.D0*X*Y*(1.D0-Y)*(1.D0-Z)
  111. FN(5)=-2.D0*X*Y*(1.D0-Z)*(1.5D0-X-Y+Z)
  112. FN(6)= 4.D0*X*Y*(1.D0-X)*(1.D0-Z)
  113. FN(7)=-2.D0*Y*(1.D0-X)*(1.D0-Z)*(0.5D0+X-Y+Z)
  114. FN(8)= 4.D0*Y*(1.D0-X)*(1.D0-Y)*(1.D0-Z)
  115. FN(9)= 4.D0*Z*(1.D0-Z)*(1.D0-X)*(1.D0-Y)
  116. FN(10)= 4.D0*X*Z*(1.D0-Z)*(1.D0-Y)
  117. FN(11)= 4.D0*X*Y*Z*(1.D0-Z)
  118. FN(12)= 4.D0*Y*Z*(1.D0-X)*(1.D0-Z)
  119. FN(13)=-2.D0*Z*(1.D0-X)*(1.D0-Y)*(X+Y-Z+0.5D0)
  120. FN(14)= 4.D0*X*Z*(1.D0-X)*(1.D0-Y)
  121. FN(15)=-2.D0*X*Z*(1.D0-Y)*(-X+Y-Z+1.5D0)
  122. FN(16)= 4.D0*X*Y*Z*(1.D0-Y)
  123. FN(17)=-2.D0*X*Y*Z*(-X-Y-Z+2.5D0)
  124. FN(18)= 4.D0*X*Y*Z*(1.D0-X)
  125. FN(19)=-2.D0*Y*Z*(1.D0-X)*(X-Y-Z+1.5D0)
  126. FN(20)= 4.D0*Y*Z*(1.D0-X)*(1.D0-Y)
  127. C
  128. DO 2722 N=1,IDIM
  129. XG(N,L)=0.D0
  130. DO 2732 I=1,20
  131. XG(N,L)=XG(N,L)+FN(I)*XA(N,I)
  132. 2732 CONTINUE
  133. 2722 CONTINUE
  134. 2712 CONTINUE
  135. RETURN
  136.  
  137. 2103 CONTINUE
  138. C PR21 -> On ne prend que les 15 premiers points correspondant au PR15
  139. DO 2112 L=1,NP
  140. X=COOR(1,L)
  141. Y=COOR(2,L)
  142. Z=COOR(3,L)
  143. C
  144. FN(1)= (X+Y-R2)*(1.D0-Z)*(X+Y+R2*Z-R2/2.D0)
  145. FN(2)=-2.D0*X*(X+Y-R2)*(1.D0-Z)
  146. FN(3)=-X*(1.D0-Z)*(-X+R2*Z+R2/2.D0)
  147. FN(4)= 2.D0*X*Y*(1.D0-Z)
  148. FN(5)=-Y*(1.D0-Z)*(-Y+R2*Z+R2/2.D0)
  149. FN(6)=-2.D0*Y*(1.D0-Z)*(X+Y-R2)
  150. FN(7)=-4.D0*Z*(1.D0-Z)*(X+Y-R2)/R2
  151. FN(8)= 4.D0*X*Z*(1.D0-Z)/R2
  152. FN(9)= 4.D0*Y*Z*(1.D0-Z)/R2
  153. FN(10)= (X+Y-R2)*Z*(X+Y+R2*(1.D0-Z)-R2/2.D0)
  154. FN(11)=-2.D0*X*Z*(X+Y-R2)
  155. FN(12)=-X*Z*(-X+R2*(1.D0-Z)+R2/2.D0)
  156. FN(13)= 2.D0*X*Y*Z
  157. FN(14)=-Y*Z*(-Y+R2*(1.D0-Z)+R2/2.D0)
  158. FN(15)=-2.D0*Y*Z*(X+Y-R2)
  159. C
  160. DO 2122 N=1,IDIM
  161. XG(N,L)=0.D0
  162. DO 2132 I=1,15
  163. XG(N,L)=XG(N,L)+FN(I)*XA(N,I)
  164. 2132 CONTINUE
  165. 2122 CONTINUE
  166. 2112 CONTINUE
  167. RETURN
  168.  
  169. 1503 CONTINUE
  170. C TE15 -> On ne prend que les 10 premiers points correspondant au TE10
  171. A=SQRT(6.D0)
  172. A2=A*A
  173. DO 1512 L=1,NP
  174. X=COOR(1,L)
  175. Y=COOR(2,L)
  176. Z=COOR(3,L)
  177. C
  178. FN(1)= 2.D0*(X+Y+A*Z-A/2.D0)*(X+Y+A*Z-A)/A2
  179. FN(2)=-4.D0*(X+Y+A*Z-A)*X/A2
  180. FN(3)= 2.D0*(X-A/2.D0)*X/A2
  181. FN(4)= 4.D0*X*Y/A2
  182. FN(5)= 2.D0*(Y-A/2.D0)*Y/A2
  183. FN(6)=-4.D0*(X+Y+A*Z-A)*Y/A2
  184. FN(7)=-4.D0*(X+Y+A*Z-A)*Z/A
  185. FN(8)= 4.D0*X*Z/A
  186. FN(9)= 4.D0*Y*Z/A
  187. FN(10)= 2.D0*Z*(Z-0.5D0)
  188. C
  189. DO 1522 N=1,IDIM
  190. XG(N,L)=0.D0
  191. DO 1532 I=1,10
  192. XG(N,L)=XG(N,L)+FN(I)*XA(N,I)
  193. 1532 CONTINUE
  194. 1522 CONTINUE
  195. 1512 CONTINUE
  196. RETURN
  197.  
  198. 1002 format(10(1x,1pe11.4))
  199. END
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  

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