Télécharger kaxc.eso

Retour à la liste

Numérotation des lignes :

  1. C KAXC SOURCE CHAT 05/01/13 00:51:51 5004
  2. SUBROUTINE KAXC(A1,A2,NP0,NG0,FF,KIMP,EXTINC,RAD)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C Include contenant quelques constantes dont XPI :
  6. -INC CCREEL
  7. C*********************************************************************
  8. C CALCUL DE S1.F12 EN GEOMETRIE CONVEXE
  9. C entree
  10. C A1 : COORDONNEES FACE 1
  11. C A2 : COORDONNEES FACE 2
  12. C NG0 : NOMBRE DE POINTS DE GAUSS (cas standard)
  13. C NP0 : NOMBRE DE POINTS D INTEGRATION (elements proches)
  14. C KIMP : paramete d'impression
  15. C EXTINC: coefficient d'extinction de la cavite si absorbante
  16. C RAD : dimension du pb (le calcul est fait en coor.reduites)
  17. C resultat
  18. C FF : S1.F12
  19. C*********************************************************************
  20. DIMENSION A1(2,2),A2(2,2)
  21. DIMENSION AL(2,20)
  22. DIMENSION AG(11,10),YA(10),HA(10),YB(10),HB(10)
  23.  
  24. C LES INTERVALLES D INTEGRATION SONT AL(I,I+1),I=1,NAL
  25. C
  26.  
  27. C estimation du mode d'integration
  28. NS=2
  29. CALL KAXDIS(A1,A2,NS,KIMP,NG0,NP0,NG,NP)
  30.  
  31. IF(KIMP.GE.3) write(6,*) ' kaxc NG NP ',NG,NP
  32.  
  33.  
  34. NM=20
  35. NAL=1
  36. AL(1,1) = 0.D0
  37. AL(2,1) = XPI
  38.  
  39. RI1=A1(1,1)
  40. ZI1=A1(2,1)
  41. RI2=A1(1,2)
  42. ZI2=A1(2,2)
  43.  
  44. RJ1=A2(1,1)
  45. ZJ1=A2(2,1)
  46. RJ2=A2(1,2)
  47. ZJ2=A2(2,2)
  48.  
  49. DRI=RI2-RI1
  50. DRJ=RJ2-RJ1
  51. DZI=ZI2-ZI1
  52. DZJ=ZJ2-ZJ1
  53.  
  54.  
  55. C>> MODE D INTEGRATION
  56. IF(NG.EQ.0) THEN
  57.  
  58. NA = NP
  59. NB = NP
  60.  
  61. C>> INTEGRATION SUR I : A
  62.  
  63. FF=0.D0
  64. DA=1.D0/NA
  65.  
  66. DO 3 IA=1,NA
  67.  
  68. A = DA/2.D0 + DA*(IA-1)
  69. RI=(1.D0-A)*RI1+A*RI2
  70. ZI=(1.D0-A)*ZI1+A*ZI2
  71. DA=1.D0/NA
  72.  
  73. C>> INTEGRATION SUR J : B
  74.  
  75. F=0.D0
  76. DB=1.D0/NB
  77.  
  78. DO 30 IB=1,NB
  79.  
  80. G=0.D0
  81. B = DB/2.D0 + DB*(IB-1)
  82. RJ=(1.D0-B)*RJ1+B*RJ2
  83. ZJ=(1.D0-B)*ZJ1+B*ZJ2
  84.  
  85. IF(KIMP.GE.4)WRITE(6,*) ' INTEGRATION IA IB ',IA,IB
  86. C
  87. C>> CALCUL
  88. C -------
  89.  
  90. CALL KATETA(RI,ZI,RJ,ZJ,DRI,DZI,DRJ,DZJ,NM,NAL,AL,G,KIMP
  91. & ,EXTINC,RAD)
  92.  
  93. F= F + 4.D0*G*DB
  94. IF(KIMP.GE.4)WRITE(6,*) ' IA IB G F ',IA,IB,G,F
  95.  
  96. 30 CONTINUE
  97.  
  98. FF = FF + F*DA
  99. IF(KIMP.GE.4) WRITE(6,*) ' IA FF ',IA,FF
  100.  
  101. 3 CONTINUE
  102.  
  103. IF(KIMP.GE.4) WRITE(6,*) ' TOTAL FF ',FF
  104.  
  105. ELSE
  106.  
  107. C>> POINTS DE GAUSS
  108.  
  109. NA = 1
  110. NB = 1
  111. NGA= NG
  112. NGA2=(NGA+1)/2
  113. NGB= NG
  114. NGB2=(NGB+1)/2
  115. CALL MATG(AG)
  116.  
  117. IF (AG(1,NGA).LT.1.D-5) THEN
  118.  
  119. YA(1)=AG(1,NGA)
  120. HA(1)=AG(2,NGA)
  121. IF(NGA2.GE.2) THEN
  122. DO 100 I=1,NGA2-1
  123. YA(I+1)=AG(2*I+1,NGA)
  124. YA(NGA2+I)=-YA(I+1)
  125. HA(I+1)=AG(2*I+2,NGA)
  126. HA(NGA2+I)=HA(I+1)
  127. 100 CONTINUE
  128. ENDIF
  129.  
  130. ELSE
  131. DO 101 I=1,NGA2
  132. YA(I)=AG(2*I-1,NGA)
  133. YA(NGA2+I)=-YA(I)
  134. HA(I)=AG(2*I,NGA)
  135. HA(NGA2+I)=HA(I)
  136. 101 CONTINUE
  137. ENDIF
  138.  
  139. IF (AG(1,NGB).LT.1.D-5) THEN
  140.  
  141. YB(1)=AG(1,NGB)
  142. HB(1)=AG(2,NGB)
  143. IF(NGB2.GE.2) THEN
  144. DO 200 I=1,NGB2-1
  145. YB(I+1)=AG(2*I+1,NGB)
  146. YB(NGB2+I)=-YA(I+1)
  147. HB(I+1)=AG(2*I+2,NGB)
  148. HB(NGB2+I)=HA(I+1)
  149. 200 CONTINUE
  150. ENDIF
  151.  
  152. ELSE
  153. DO 201 I=1,NGB2
  154. YB(I)=AG(2*I-1,NGB)
  155. YB(NGA2+I)=-YB(I)
  156. HB(I)=AG(2*I,NGB)
  157. HB(NGA2+I)=HB(I)
  158. 201 CONTINUE
  159. ENDIF
  160.  
  161. C>> INTEGRATION SUR I : A
  162.  
  163. FF=0.D0
  164. DA=1.D0/NA
  165. DO 1 IA=1,NA
  166. A = DA/2.D0 + DA*(IA-1)
  167. DA=1.D0/NA
  168. C bornes
  169. AL1=A-DA/2.D0
  170. AL2=A+DA/2.D0
  171.  
  172. C>> GAUSS SUR I : A
  173. FA=0.D0
  174. DO 11 IGA=1,NGA
  175. C YA varie entre -1 et 1.D0
  176. ALL= (YA(IGA)+1.D0)*(AL2-AL1)/2.D0 + AL1
  177. RI=(1.D0-ALL)*RI1+ALL*RI2
  178. ZI=(1.D0-ALL)*ZI1+ALL*ZI2
  179.  
  180. C>> INTEGRATION SUR J : B
  181.  
  182. F=0.D0
  183. DB=1.D0/NB
  184. DO 2 IB=1,NB
  185. B = DB/2.D0 + DB*(IB-1)
  186. C bornes
  187. BL1=B-DB/2.D0
  188. BL2=B+DB/2.D0
  189.  
  190. C>> GAUSS SUR J : B
  191. FB=0.D0
  192. DO 21 IGB=1,NGB
  193. C YB varie entre -1 et 1.D0
  194. BLL=(YB(IGB)+1.D0)*(BL2-BL1)/2.D0 + BL1
  195. RJ=(1.D0-BLL)*RJ1+BLL*RJ2
  196. ZJ=(1.D0-BLL)*ZJ1+BLL*ZJ2
  197.  
  198. G=0.D0
  199. C
  200. C>> CALCUL
  201. C -------
  202.  
  203. CALL KATETA(RI,ZI,RJ,ZJ,DRI,DZI,DRJ,DZJ,NM,NAL,AL,G
  204. $ ,KIMP,EXTINC,RAD)
  205.  
  206. FB = FB + 4.D0*G*HB(IGB)*(BL2-BL1)/2.D0
  207.  
  208. 21 CONTINUE
  209. F= F + FB*DB
  210.  
  211. 2 CONTINUE
  212.  
  213. FA = FA + F*HA(IGA)*(AL2-AL1)/2.D0
  214.  
  215. 11 CONTINUE
  216.  
  217. FF = FF + FA*DA
  218.  
  219. 1 CONTINUE
  220.  
  221. ENDIF
  222.  
  223. RETURN
  224. END
  225.  
  226.  
  227.  
  228.  
  229.  
  230.  
  231.  
  232.  
  233.  

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