Télécharger chamar.eso

Retour à la liste

Numérotation des lignes :

  1. C CHAMAR SOURCE CHAT 05/01/12 21:54:46 5004
  2. SUBROUTINE CHAMAR(IUNIT,IC,CC,A1,A2,RI,ALFA,BETA,DENS,XP,YP,ZP,
  3. + BXP,BYP,BZP)
  4. C-----------------------------------------------------------------------
  5. CALCUL DU CHAMP D'UN ARC DE BOBINE RECTANGULAIRE
  6. C IUNIT INDIQUE LES UNITES CHOISIES:
  7. C IUNIT=0 OU 1 IUNIT=2 IUNIT=3
  8. C DIMENSIONS EN M MM MM
  9. C DENSITE DE COURANT EN A/M2 A/MM2 A/MM2
  10. C CHAMP EN TESLA TESLA GAUSS
  11. C GRADIENTS EN TESLA/M TESLA/MM GAUSS/MM
  12. C FMUJ=MU*DENS/4*XPI 1E-7*DENS 1E-4*DENS DENS
  13. C
  14. C PRECIS=PRECISION RELATIVE DEMANDEE DU CALCUL DES INTEGRALES
  15. C PRABW=PRECISION ABSOLUE DU CALCUL SUR LA COMPOSANTE BW
  16. C
  17. C IF(IC.EQ.1) CALCUL DE LA COMPOSANTE BZP SEULE
  18. C IF(IC.EQ.2) CALCUL DES COMPOSANTES BXP ET BYP SEULES
  19. C IF(IC.NE.1.OR.NE.2) CALCUL DES TROIS COMPOSANTES BZP BYP BXP
  20. C-----------------------------------------------------------------------
  21. IMPLICIT INTEGER(I-N)
  22. IMPLICIT REAL*8 (A-H,O-Z)
  23. EXTERNAL FONZ,FONR,FONT
  24. DIMENSION CC(3)
  25. -INC CCREEL
  26. -INC CCOPTIO
  27. COMMON/CMCHAM/ D1,D2,R,A,U,DD1,DD2,LSOMD,LD1,LD2
  28. LOGICAL LSOMD,LSOMT,LD1,LD2,LR
  29. BXP=0.D0
  30. BYP=0.D0
  31. BZP=0.D0
  32. BRP=0.D0
  33. BTP=0.D0
  34. PRABZ=0.D0
  35. UPSI=0.000001D0
  36. U=1.D0
  37. UU=1.D0
  38. FMUJ=DENS*0.0000001D0
  39. IF(IUNIT.EQ.2) FMUJ=DENS*0.0001D0
  40. IF(IUNIT.EQ.3) FMUJ=DENS
  41. RMUJ=FMUJ*RI
  42. X=XP-CC(1)
  43. Y=YP-CC(2)
  44. RP=SQRT(X**2+Y**2)
  45. Z=(ZP-CC(3))/RI
  46. D1=Z-BETA
  47. D2=Z+BETA
  48. R=RP/RI
  49. A=ALFA
  50. DD1=D1**2
  51. DD2=D2**2
  52. AA=A**2
  53. LR=R.LE.UPSI
  54. LSOMD=ABS(D1+D2).LE.UPSI
  55. LD1=ABS(D1).LE.UPSI
  56. LD2=ABS(D2).LE.UPSI
  57. IF(LR) GOTO 2
  58. TAU=ASIN(Y/RP)
  59. IF(X.LT.0.D0) TAU=XPI-TAU
  60. T1=A1-TAU
  61. T2=A2-TAU
  62. ABST=ABS(T1+T2)
  63. LSOMT=(ABST.LE.UPSI).OR.(ABS(ABST-2.D0*XPI).LE.UPSI)
  64. IF(LSOMT) T1=(T1+T2)/2.D0
  65. COSTAU=COS(TAU)
  66. SINTAU=SIN(TAU)
  67. C
  68. CAS OU R.NE.0.D0
  69. IF(IC.EQ.2) GOTO 11
  70. CALCUL DE LA COMPOSANTE AXIALE BZP
  71. ACBZ=0.D0
  72. SOMBZ= GQUAD(FONZ,T1,T2,80)
  73. IF(IERR.NE.0) RETURN
  74. BZP=RMUJ*(SOMBZ+FZ4(T2)-FZ4(T1))
  75. IF(LSOMT) BZP=2.D0*BZP
  76. PRABZ=ABS(ACBZ*SOMBZ*RMUJ)
  77. IF(SOMBZ.EQ.0.D0) PRABZ=RMUJ*ACBZ
  78. IF(LSOMT) PRABZ=2.D0*PRABZ
  79. IF(IC.EQ.1) RETURN
  80. 11 CONTINUE
  81. CALCUL DE LA COMPOSANTE RADIALE BRP
  82. IF(LSOMD) RETURN
  83. SOMBR= GQUAD(FONR,T1,T2,80)
  84. IF(IERR.NE.0) RETURN
  85. IF(LSOMT) SOMBR=2.D0*SOMBR
  86. BRP=RMUJ*SOMBR
  87. CALCUL DE LA COMPOSANTE TANGENTIELLE
  88. IF(LSOMT) GOTO 3
  89. SOMBT= GQUAD(FONT,T1,T2,80)
  90. IF(IERR.NE.0) RETURN
  91. BTP=RMUJ*SOMBT
  92. 3 CONTINUE
  93. CALCUL DES COMPOSANTES BXP ET BYP
  94. BXP=BRP*COSTAU-BTP*SINTAU
  95. BYP=BRP*SINTAU+BTP*COSTAU
  96. RETURN
  97. 2 CONTINUE
  98. C
  99. CAS OU R.EQ.0.D0
  100. SQA2=SQRT(AA+DD2)
  101. SQA1=SQRT(AA+DD1)
  102. SQU2=SQRT(UU+DD2)
  103. SQU1=SQRT(UU+DD1)
  104. IF(IC.EQ.2) GOTO 22
  105. SOMLG2=LOG((A+SQA2)/(U+SQU2))
  106. SOMLG1=LOG((A+SQA1)/(U+SQU1))
  107. BZP=RMUJ*(D2*SOMLG2-D1*SOMLG1)*(A2-A1)
  108. IF(IC.EQ.1) RETURN
  109. 22 CONTINUE
  110. IF(LSOMD) RETURN
  111. SOR=SQA2-SQA1-SQU2+SQU1
  112. BXP=RMUJ*SOR*(SIN(A1)-SIN(A2))
  113. BYP=RMUJ*SOR*(COS(A2)-COS(A1))
  114. RETURN
  115. END
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  

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