Télécharger cq2ksg.eso

Retour à la liste

Numérotation des lignes :

  1. C CQ2KSG SOURCE CHAT 05/01/12 22:26:43 5004
  2. SUBROUTINE CQ2KSG(COO,EP,DIM3,IFOU,AN,NBPGAU,XSTRS,RAYON,
  3. . RAY,TGAUS,CGAUS,ALF11,ALF12,ALF21,ALF22,A4,S3,AM,A1,A,LRE,REL
  4. $ )
  5. *-----------------------------------------------------------------------
  6. C CALCUL DE LA MATRICE KSIGMA POUR UNE COQUE A 2 NOEUDS
  7. C FEVRIER 86 ; X. DE MAZANCOURT
  8. C PROGRAMME REPRIS A 90% SUR LE COQFLA DE INCA
  9. *-----------------------------------------------------------------------
  10. C ENTREES:
  11. C COO:COORDONNEES DE L'ELEMENT
  12. C EP:EPAISSEUR DE LA COQUE
  13. C IFOU = VALEUR DE IFOUR DE CCOPTIO
  14. C AN:NUMERO DE L'HARMONIQUE DE FOURIER
  15. C XSTRS:CONTRAINTES
  16. C NBPGAU:NOMBRE DE POINTS DE GAUSS
  17. C TGAUS:POSITION DES POINTS DE GAUSS
  18. C CGAUS:POIDS DES POINTS DE GAUSS
  19. C RAYON,RAY,ALF:TABLEAUX DE TRAVAIL
  20. C LRE = TAILLE DE LA MATRICE KSIGMA
  21. C SORTIES:
  22. C REL:MATRICE KSIGMA
  23. *-----------------------------------------------------------------------
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8 (A-H,O-Z)
  26. C Include contenant quelques constantes dont XPI :
  27. -INC CCREEL
  28. PARAMETER(UN=1.D0,UNDEMI=.5D0,UNQUAR=.25D0)
  29. DIMENSION A4(8,*),S3(8,*),AM(8,*),A1(8,*)
  30. DIMENSION COO(3,*),A(8,*),TGAUS(*),CGAUS(*)
  31. DIMENSION ALF11(*),ALF12(*),ALF21(*),ALF22(*),RAYON(*),REL(LRE,*)
  32. DIMENSION RAY(*),XSTRS(*),II(6)
  33. DATA II/1,2,4,5,6,8/
  34. C --------------------------------PRELIMINAIRES
  35. CALL ZERO(REL,LRE,LRE)
  36. RAYON(1)=COO(1,1)
  37. RAYON(3)=COO(1,2)
  38. RAYON(2)=(RAYON(1)+RAYON(3))*UNDEMI
  39. DR=RAYON(3)-RAYON(1)
  40. DZ=COO(2,2)-COO(2,1)
  41. DS=SQRT(DR*DR+DZ*DZ)
  42. COSP=DR/DS
  43. SINP=DZ/DS
  44. XS2=UNDEMI*DS
  45. XS4=UNQUAR*DS
  46. C --------------------------------
  47. CALL RESO1K(A4,DS,COSP,SINP,S3,A)
  48. CALL ZERO(ALF12,5,1)
  49. CALL ZERO(ALF22,7,1)
  50. C --------------------------------BOUCLE SUR LES POINTS DE GAUSS
  51. DO 9 IN=1,NBPGAU
  52. C ID1=1+(IN-1)*6
  53. C ID2=2+(IN-1)*6
  54. RAY(IN)=RAYON(2)+XS2*COSP*TGAUS(IN)
  55. X=TGAUS(IN)*XS2
  56. X2=X*X
  57. X3=X2*X
  58. X4=X3*X
  59. C ANS=EP*XSTRS(ID1)
  60. C ANT=EP*XSTRS(ID2)
  61. C
  62. C ON PEUT FAIRE VARIER LES CONTRAINTES AVEC LE POINT DE GAUSS
  63. C MAIS ON A CHOISI DE PRENDRE CELLES DU 2} POINT DE GAUSS...
  64. C
  65. IF (IFOU.EQ.1) THEN
  66. ANS=EP*XSTRS(7)
  67. ANT=EP*XSTRS(8)
  68. ELSE
  69. ANS=EP*XSTRS(5)
  70. ANT=EP*XSTRS(6)
  71. ENDIF
  72. ALF11(1)=UN
  73. ALF11(2)=X
  74. ALF11(3)=X2
  75. ALF11(4)=X3
  76. ALF11(5)=X4
  77. DO 12 NC=1,5
  78. ALF21(NC)=ALF11(NC)
  79. 12 CONTINUE
  80. ALF21(6)=X4*X
  81. ALF21(7)=X4*X2
  82. RRRR=RAY(IN)
  83. IF(IFOU.EQ.-3) RRRR=UN
  84. *
  85. * LE CAS DES DEF. PLANES GENERALISEES SERA A TESTER ||||
  86. *
  87. IF(IFOU.EQ.-1.OR.IFOU.EQ.-2) THEN
  88. ANS=ANS*XS4*CGAUS(IN)
  89. ANT=0.D0
  90. ELSE
  91. ANS=ANS*RRRR*XS4*CGAUS(IN)
  92. ANT=(ANT*XS4*CGAUS(IN))/RRRR
  93. ENDIF
  94. IF (IFOU.EQ.0.OR.(IFOU.EQ.1.AND.AN.EQ.0)) THEN
  95. ANS=ANS*2*XPI
  96. ANT=ANT*2*XPI
  97. ELSEIF (IFOU.EQ.1.AND.AN.NE.0) THEN
  98. ANS=ANS*XPI
  99. ANT=ANT*XPI
  100. ENDIF
  101. ANS=ANS*DIM3
  102. ANT=ANT*DIM3
  103. CALL AMUL1K(ALF11,5,ANS,ALF12)
  104. CALL AMUL1K(ALF21,7,ANT,ALF22)
  105. C ---------------------------------------
  106. 9 CONTINUE
  107. C
  108. C TRANSFERT DE ALF12 (RESP.ALF22) DANS ALF11 (RESP.ALF21)
  109. C
  110. CALL SHIF1K(ALF12,ALF11,5)
  111. CALL SHIF1K(ALF22,ALF21,7)
  112. C
  113. C CALCUL DE A1,TRANSPOSEE DE A4
  114. C
  115. DO 15 NC=1,8
  116. DO 13 NCC=1,8
  117. A1(NCC,NC)=A4(NC,NCC)
  118. 13 CONTINUE
  119. 15 CONTINUE
  120. CALL ZERO(A,8,8)
  121. PROD1=COSP*COSP
  122. PROD2=SINP*SINP
  123. PROD3=SINP*COSP
  124. A(1,1)=PROD1*ALF21(1)
  125. A(1,2)=PROD1*ALF21(2)
  126. A(1,5)=PROD3*ALF21(1)
  127. A(1,6)=PROD3*ALF21(2)
  128. A(1,7)=PROD3*ALF21(3)
  129. A(1,8)=PROD3*ALF21(4)
  130. A(2,1)=A(1,2)
  131. A(2,2)=ALF11(1)+PROD1*ALF21(3)
  132. A(2,5)=PROD3*ALF21(2)
  133. A(2,6)=PROD3*ALF21(3)
  134. A(2,7)=PROD3*ALF21(4)
  135. A(2,8)=PROD3*ALF21(5)
  136. A(3,3)=ALF21(1)
  137. A(3,4)=ALF21(2)
  138. A(4,3)=A(3,4)
  139. A(4,4)=ALF11(1)+ALF21(3)
  140. A(5,1)=A(1,5)
  141. A(5,2)=A(2,5)
  142. A(5,5)=PROD2*ALF21(1)
  143. A(5,6)=PROD2*ALF21(2)
  144. A(5,7)=PROD2*ALF21(3)
  145. A(5,8)=PROD2*ALF21(4)
  146. A(6,1)=A(1,6)
  147. A(6,2)=A(2,6)
  148. A(6,5)=A(5,6)
  149. A(6,6)=ALF11(1)+A(5,7)
  150. A(6,7)=ALF11(2)*2.D0+A(5,8)
  151. A(6,8)=ALF11(3)*3.D0+PROD2*ALF21(5)
  152. A(7,1)=A(1,7)
  153. A(7,2)=A(2,7)
  154. A(7,5)=A(5,7)
  155. A(7,6)=A(6,7)
  156. A(7,7)=ALF11(3)*4.D0+PROD2*ALF21(5)
  157. A(7,8)=ALF11(4)*6.D0+PROD2*ALF21(6)
  158. A(8,1)=A(1,8)
  159. A(8,2)=A(2,8)
  160. A(8,5)=A(5,8)
  161. A(8,6)=A(6,8)
  162. A(8,7)=A(7,8)
  163. A(8,8)=ALF11(5)*9.D0+PROD2*ALF21(7)
  164. 20 CONTINUE
  165. CALL MULMAT (S3,A,A4,8,8,8)
  166. CALL MULMAT (A,A1,S3,8,8,8)
  167. CALL ZERO(AM,8,8)
  168. AM(1,1)=ALF21(1)
  169. AM(3,3)=ALF21(1)
  170. AM(5,5)=ALF21(1)
  171. AM(1,2)=ALF21(2)
  172. AM(2,1)=ALF21(2)
  173. AM(3,4)=ALF21(2)
  174. AM(4,3)=ALF21(2)
  175. AM(5,6)=ALF21(2)
  176. AM(6,5)=ALF21(2)
  177. AM(2,2)=ALF21(3)
  178. AM(4,4)=ALF21(3)
  179. AM(6,6)=ALF21(3)
  180. AM(5,7)=ALF21(3)
  181. AM(7,5)=ALF21(3)
  182. AM(5,8)=ALF21(4)
  183. AM(8,5)=ALF21(4)
  184. AM(6,7)=ALF21(4)
  185. AM(7,6)=ALF21(4)
  186. AM(7,7)=ALF21(5)
  187. AM(6,8)=ALF21(5)
  188. AM(8,6)=ALF21(5)
  189. AM(7,8)=ALF21(6)
  190. AM(8,7)=ALF21(6)
  191. AM(8,8)=ALF21(7)
  192. CALL MULMAT (S3,AM,A4,8,8,8)
  193. CALL MULMAT (AM,A1,S3,8,8,8)
  194. AN2=AN*AN
  195. DO 30 NC=1,8
  196. DO 31 NCC=1,8
  197. A(NCC,NC)=A(NCC,NC)+AN2*AM(NCC,NC)
  198. 31 CONTINUE
  199. 30 CONTINUE
  200. PROD1=2.D0*COSP
  201. PROD2=2.D0*SINP
  202. CALL ZERO(AM,8,8)
  203. AM(1,3)=PROD1*ALF21(1)
  204. AM(1,4)=PROD1*ALF21(2)
  205. AM(2,3)=AM(1,4)
  206. AM(2,4)=PROD1*ALF21(3)
  207. AM(3,1)=AM(1,3)
  208. AM(3,2)=AM(2,3)
  209. AM(3,5)=PROD2*ALF21(1)
  210. AM(3,6)=PROD2*ALF21(2)
  211. AM(3,7)=PROD2*ALF21(3)
  212. AM(3,8)=PROD2*ALF21(4)
  213. AM(4,1)=AM(1,4)
  214. AM(4,2)=AM(2,4)
  215. AM(4,5)=AM(3,6)
  216. AM(4,6)=AM(3,7)
  217. AM(4,7)=AM(3,8)
  218. AM(7,4)=AM(4,7)
  219. AM(4,8)=PROD2*ALF21(5)
  220. AM(5,3)=AM(3,5)
  221. AM(5,4)=AM(4,5)
  222. AM(6,3)=AM(3,6)
  223. AM(6,4)=AM(4,6)
  224. AM(7,3)=AM(3,7)
  225. AM(8,3)=AM(3,8)
  226. AM(8,4)=AM(4,8)
  227. 19 CONTINUE
  228. CALL MULMAT (S3,AM,A4,8,8,8)
  229. CALL MULMAT (AM,A1,S3,8,8,8)
  230. C
  231. C CALCUL FINAL DE LA MATRICE KSIGMA
  232. C
  233. IF(IFOU.EQ.1) THEN
  234. DO 32 NC=1,8
  235. DO 33 NCC=1,8
  236. REL(NCC,NC) =(A(NCC,NC)+AN*AM(NCC,NC))*2.D0
  237. 33 CONTINUE
  238. 32 CONTINUE
  239. ELSE IF(IFOU.EQ.0.OR.IFOU.EQ.-1.OR.IFOU.EQ.-2) THEN
  240. DO 82 NC=1,6
  241. IC=II(NC)
  242. DO 83 NCC=1,6
  243. ICC=II(NCC)
  244. REL(NCC,NC) =(A(ICC,IC)+AN*AM(ICC,IC))*2.D0
  245. 83 CONTINUE
  246. 82 CONTINUE
  247. ENDIF
  248. RETURN
  249. END
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  

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