Télécharger kaxk.eso

Retour à la liste

Numérotation des lignes :

  1. C KAXK SOURCE CHAT 05/01/13 00:51:57 5004
  2. SUBROUTINE KAXK(A1,A2,OBS,NOBS,NT,NP0,NG0,FF,KIMP,EXTINC,RAD)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C*********************************************************************
  6. C CALCUL DE S1.F12 EN TENANT COMPTE DES OBSTRUCTEURS
  7. C entree
  8. C A1 : COORDONNEES FACE 1
  9. C A2 : COORDONNEES FACE 2
  10. C OBS : COORDONNES DES OBSTRUCTEURS POTENTIELS
  11. C NOBS : NOMBRE D'OBSTRUCTEURS POTENTIELS
  12. C NG0 : NOMBRE DE POINTS DE GAUSS (cas standard)
  13. C NP0 : NOMBRE DE POINTS D'INTEGRATION (elements proches)
  14. C KIMP : parametre 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),OBS(2,NT)
  21. DIMENSION AL(2,20),BL(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. NM=20
  27.  
  28.  
  29. C estimation du mode d'integration
  30. NS=2
  31. CALL KAXDIS(A1,A2,NS,KIMP,NG0,NP0,NG,NP)
  32.  
  33. IF(KIMP.GE.3) write(6,*) ' kaxk NG NP ',NG,NP
  34.  
  35. RI1=A1(1,1)
  36. ZI1=A1(2,1)
  37. RI2=A1(1,2)
  38. ZI2=A1(2,2)
  39.  
  40. RJ1=A2(1,1)
  41. ZJ1=A2(2,1)
  42. RJ2=A2(1,2)
  43. ZJ2=A2(2,2)
  44.  
  45. DRI=RI2-RI1
  46. DRJ=RJ2-RJ1
  47. DZI=ZI2-ZI1
  48. DZJ=ZJ2-ZJ1
  49.  
  50.  
  51. C>> MODE D INTEGRATION
  52. IF(NG.EQ.0) THEN
  53.  
  54. NA = NP
  55. NB = NP
  56.  
  57. C>> INTEGRATION SUR I : A
  58.  
  59. FF=0.D0
  60. DA=1./NA
  61.  
  62. DO 3 IA=1,NA
  63.  
  64. A = DA/2. + DA*(IA-1)
  65. RI=(1.-A)*RI1+A*RI2
  66. ZI=(1.-A)*ZI1+A*ZI2
  67. DA=1./NA
  68.  
  69. C>> INTEGRATION SUR J : B
  70.  
  71. F=0.D0
  72. DB=1./NB
  73.  
  74. DO 30 IB=1,NB
  75.  
  76. G=0.D0
  77. B = DB/2. + DB*(IB-1)
  78. RJ=(1.-B)*RJ1+B*RJ2
  79. ZJ=(1.-B)*ZJ1+B*ZJ2
  80.  
  81. IF(KIMP.GE.4)WRITE(6,*) ' INTEGRATION IA IB ',IA,IB
  82.  
  83. C>> LIMITES DE VISIBILITE PROPRE AUX POINTS I ET J
  84. C ----------------------------------------------
  85.  
  86. CALL KAVOWN(RI,ZI,RJ,ZJ,DRI,DZI,DRJ,DZJ,KVU,NM,NAL,AL,KIMP)
  87. IF(KIMP.GE.4) THEN
  88. WRITE(6,*) ' VISIBILITE PROPRE ',KVU
  89. IF(KVU.NE.0)CALL UTPRIN(AL,2,NAL)
  90. ENDIF
  91. C
  92. C>> TRAITEMENT DES OBSTRUCTEURS
  93. C ----------------------------
  94. IF(KVU.NE.0.AND.NOBS.NE.0) THEN
  95. CALL KAVOTH(RI,ZI,RJ,ZJ,OBS,NOBS,NT,KVU,NAL,NM,AL,BL,KIMP)
  96. IF(KIMP.GE.4) THEN
  97. WRITE(6,*) ' OBSTRUCTEURS ',KVU
  98. IF(KVU.NE.0)CALL UTPRIN(AL,2,NAL)
  99. ENDIF
  100. ENDIF
  101. C
  102. C>> CALCUL
  103. C -------
  104.  
  105. IF(KVU.NE.0) THEN
  106. CALL KATETA(RI,ZI,RJ,ZJ,DRI,DZI,DRJ,DZJ,NM,NAL,AL,G,KIMP
  107. & ,EXTINC,RAD)
  108. ENDIF
  109.  
  110. F= F + 4.*G*DB
  111. IF(KIMP.GE.4)WRITE(6,*) ' IA IB G F ',IA,IB,G,F
  112.  
  113. 30 CONTINUE
  114.  
  115. FF = FF + F*DA
  116. IF(KIMP.GE.4) WRITE(6,*) ' IA FF ',IA,FF
  117.  
  118. 3 CONTINUE
  119.  
  120. IF(KIMP.GE.4) WRITE(6,*) ' TOTAL FF ',FF
  121.  
  122. ELSE
  123.  
  124. C>> POINTS DE GAUSS
  125.  
  126. NA = 1
  127. NB = 1
  128. NGA= NG
  129. NGA2=(NGA+1)/2
  130. NGB= NG
  131. NGB2=(NGB+1)/2
  132. CALL MATG(AG)
  133.  
  134. IF (AG(1,NGA).LT.1.E-5) THEN
  135.  
  136. YA(1)=AG(1,NGA)
  137. HA(1)=AG(2,NGA)
  138. IF(NGA2.GE.2) THEN
  139. DO 100 I=1,NGA2-1
  140. YA(I+1)=AG(2*I+1,NGA)
  141. YA(NGA2+I)=-YA(I+1)
  142. HA(I+1)=AG(2*I+2,NGA)
  143. HA(NGA2+I)=HA(I+1)
  144. 100 CONTINUE
  145. ENDIF
  146.  
  147. ELSE
  148. DO 101 I=1,NGA2
  149. YA(I)=AG(2*I-1,NGA)
  150. YA(NGA2+I)=-YA(I)
  151. HA(I)=AG(2*I,NGA)
  152. HA(NGA2+I)=HA(I)
  153. 101 CONTINUE
  154. ENDIF
  155.  
  156. IF (AG(1,NGB).LT.1.E-5) THEN
  157.  
  158. YB(1)=AG(1,NGB)
  159. HB(1)=AG(2,NGB)
  160. IF(NGB2.GE.2) THEN
  161. DO 200 I=1,NGB2-1
  162. YB(I+1)=AG(2*I+1,NGB)
  163. YB(NGB2+I)=-YA(I+1)
  164. HB(I+1)=AG(2*I+2,NGB)
  165. HB(NGB2+I)=HA(I+1)
  166. 200 CONTINUE
  167. ENDIF
  168.  
  169. ELSE
  170. DO 201 I=1,NGB2
  171. YB(I)=AG(2*I-1,NGB)
  172. YB(NGA2+I)=-YB(I)
  173. HB(I)=AG(2*I,NGB)
  174. HB(NGA2+I)=HB(I)
  175. 201 CONTINUE
  176. ENDIF
  177.  
  178. C>> INTEGRATION SUR I : A
  179.  
  180. FF=0.D0
  181. DA=1./NA
  182. DO 1 IA=1,NA
  183. A = DA/2. + DA*(IA-1)
  184. DA=1./NA
  185. C bornes
  186. AL1=A-DA/2.
  187. AL2=A+DA/2.
  188.  
  189. C>> GAUSS SUR I : A
  190. FA=0.D0
  191. DO 11 IGA=1,NGA
  192. C YA varie entre -1 et 1.
  193. ALL= (YA(IGA)+1.)*(AL2-AL1)/2. + AL1
  194. RI=(1.-ALL)*RI1+ALL*RI2
  195. ZI=(1.-ALL)*ZI1+ALL*ZI2
  196.  
  197. C>> INTEGRATION SUR J : B
  198.  
  199. F=0.D0
  200. DB=1./NB
  201. DO 2 IB=1,NB
  202. B = DB/2. + DB*(IB-1)
  203. C bornes
  204. BL1=B-DB/2.
  205. BL2=B+DB/2.
  206.  
  207. C>> GAUSS SUR J : B
  208. FB=0.D0
  209. DO 21 IGB=1,NGB
  210. C YB varie entre -1 et 1.
  211. BLL=(YB(IGB)+1.)*(BL2-BL1)/2. + BL1
  212. RJ=(1.-BLL)*RJ1+BLL*RJ2
  213. ZJ=(1.-BLL)*ZJ1+BLL*ZJ2
  214.  
  215. G=0.D0
  216. IF(KIMP.GE.4)WRITE(6,*) ' INTEGRATION IGA IGB ',IGA,IGB
  217.  
  218. C>> LIMITES DE VISIBILITE PROPRE AUX POINTS I ET J
  219. C ----------------------------------------------
  220.  
  221. CALL KAVOWN(RI,ZI,RJ,ZJ,DRI,DZI,DRJ,DZJ,KVU,NM,NAL,AL,KIMP)
  222. IF(KIMP.GE.4) THEN
  223. WRITE(6,*) ' VISIBILITE PROPRE ',KVU
  224. IF(KVU.NE.0)CALL UTPRIN(AL,2,NAL)
  225. ENDIF
  226. C
  227. C>> TRAITEMENT DES OBSTRUCTEURS
  228. C ----------------------------
  229. IF(KVU.NE.0.AND.NOBS.NE.0) THEN
  230. CALL KAVOTH(RI,ZI,RJ,ZJ,OBS,NOBS,NT,KVU,NAL,NM,AL,BL,KIMP)
  231. IF(KIMP.GE.4) THEN
  232. WRITE(6,*) ' OBSTRUCTEURS ',KVU
  233. IF(KVU.NE.0)CALL UTPRIN(AL,2,NAL)
  234. ENDIF
  235. ENDIF
  236. C
  237. C>> CALCUL
  238. C -------
  239.  
  240. IF(KVU.NE.0) THEN
  241. CALL KATETA(RI,ZI,RJ,ZJ,DRI,DZI,DRJ,DZJ,NM,NAL,AL,G,KIMP
  242. & ,EXTINC,RAD)
  243. ENDIF
  244.  
  245. FB = FB + 4.*G*HB(IGB)*(BL2-BL1)/2.
  246.  
  247. 21 CONTINUE
  248. F= F + FB*DB
  249.  
  250. 2 CONTINUE
  251.  
  252. FA = FA + F*HA(IGA)*(AL2-AL1)/2.
  253.  
  254. 11 CONTINUE
  255.  
  256. FF = FF + FA*DA
  257.  
  258. 1 CONTINUE
  259.  
  260. ENDIF
  261.  
  262. RETURN
  263. END
  264.  
  265.  
  266.  
  267.  
  268.  

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