Télécharger la plaquette Cast3M


fr en

Télécharger kaxk.eso

Retour à la liste

Numérotation des lignes : 

kaxk

  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